1:- module(plammar, [
2 tree/3,
3 tree/4,
4 prolog_tokens/2,
5 prolog_tokens/3,
6 prolog_parsetree/2,
7 prolog_parsetree/3,
8 prolog_ast/2,
9 prolog_ast/3
10 ]). 11
12:- use_module(library(apply), [maplist/3]). 13:- use_module(library(lists), [append/3]). 14:- use_module(library(readutil), [read_file_to_codes/3]). 15:- use_module(library(option), [merge_options/3,option/2,option/3]). 16:- use_module(library(clpfd)). 17
18:- use_module(library(dcg4pt)). 19
20:- use_module(plammar/environments). 21:- use_module(plammar/util). 22:- use_module(plammar/options). 23:- use_module(plammar/pt_ast). 24:- use_module(plammar/state). 25
26prolog_tokens(A, B) :-
27 prolog_tokens(A, B, []).
28
29prolog_tokens(string(String), Tokens, Options) :-
30 !,
31 I0 = string_chars(String, Chars),
32 I1 = prolog_tokens(chars(Chars), Tokens, Options),
33 ( nonvar(String) -> Instructions = (I0, I1)
34 ; Instructions = (I1, I0) ),
35 Instructions.
36
37prolog_tokens(file(File), Tokens, Options) :-
38 nonvar(File),
39 !,
40 setup_call_cleanup(
41 open(File, read, Stream),
42 prolog_tokens(stream(Stream), Tokens, Options),
43 close(Stream)
44 ).
45
46prolog_tokens(stream(Stream), Tokens, Options) :-
47 nonvar(Stream),
48 !,
49 read_string(Stream, _Length, String),
50 prolog_tokens(string(String), Tokens, Options).
51
52prolog_tokens(chars(Chars), Tokens, User_Options) :-
53 !,
54 normalise_options(prolog_tokens, User_Options, Options),
55 prolog_tokens_(chars(Chars), Tokens, Options),
56 revise_options(prolog_tokens, Options).
57
58prolog_tokens(_, _, _) :-
59 !,
60 setof(
61 Type,
62 [Selector,Argument,Body,A,B]^(
63 clause(prolog_tokens(Selector,A,B), Body),
64 nonvar(Selector),
65 Selector =.. [Type, Argument]
66 ),
67 Types
68 ),
69 warning('Use one of input formats string ~w', Types).
70
71prolog_tokens_(chars(Chars), Tokens, Options) :-
73 tokens(Options, Tokens, Chars).
74
75prolog_parsetree(A, B) :-
76 prolog_parsetree(A, B, []).
77
78prolog_parsetree(string(String), PT, Options) :-
79 nonvar(String),
80 !,
81 string_chars(String, Chars),
82 prolog_parsetree(chars(Chars), PT, Options).
83prolog_parsetree(string(String), PT, Options) :-
84 nonvar(PT),
85 !,
86 prolog_parsetree(chars(Chars), PT, Options),
87 string_chars(String, Chars).
88
89prolog_parsetree(file(File), PT, Options) :-
90 nonvar(File),
91 !,
92 setup_call_cleanup(
93 open(File, read, Stream),
94 prolog_parsetree(stream(Stream), PT, Options),
95 close(Stream)
96 ).
97
98prolog_parsetree(stream(Stream), PT, Options) :-
99 nonvar(Stream),
100 !,
101 read_string(Stream, _Length, String),
102 prolog_parsetree(string(String), PT, Options).
103
104prolog_parsetree(chars(Chars), PT, User_Options) :-
105 !,
106 normalise_options(prolog_parsetree, User_Options, Options),
107 prolog_parsetree_(chars(Chars), PT, Options),
108 revise_options(prolog_parsetree, Options).
109
110prolog_parsetree(tokens(Tokens), PT, User_Options) :-
111 !,
112 normalise_options(prolog_parsetree, User_Options, Options),
113 prolog(Options, PT, Tokens),
114 revise_options(prolog_parsetree, Options).
115
116
117prolog_parsetree(_, _, _) :-
118 !,
119 setof(
120 Type,
121 [Selector,Argument,Body,A,B]^(
122 clause(prolog_parsetree(Selector,A,B), Body),
123 nonvar(Selector),
124 Selector =.. [Type, Argument]
125 ),
126 Types
127 ),
128 warning('Use one of input formats ~w', [Types]).
129
130prolog_parsetree_(chars(Chars), PT, Options) :-
131 I0 = prolog_tokens(chars(Chars), Tokens, Options),
132 I1 = prolog(Options, PT, Tokens),
133 ( nonvar(Chars) -> Instructions = (I0, !, I1)
134 ; Instructions = (I1, !, I0) ),
135 Instructions.
136
137
138prolog_ast(Source, AST) :-
139 prolog_ast(Source, AST, []).
140
141prolog_ast(Source, AST, Opts0) :-
142 normalise_options(prolog_parsetree, Opts0, Opts),
143 I0 = prolog_parsetree(Source, PT, Opts),
144 I1 = parsetree_ast(PT, AST, Opts),
145 ( ground(Source) ->
146 Instructions = (I0, I1)
147 ; Instructions = (I1, I0) ),
148 Instructions, !.
149
150prolog_ast(Source, AST, Options) :-
151 nonvar(AST),
152 parsetree_ast(PT, AST, Options),
153 prolog_parsetree(Source, PT, Options).
154
155parsetree_ast(PT, AST) :-
156 parsetree_ast(PT, AST, []).
157
158parsetree_ast(PT, AST, User_Options) :-
159 normalise_options(User_Options, Options),
160 initial_state(Options, S0),
161 pt_ast(Options, S0, SN, PT, AST),
162 option(end_state(SN), Options),
163 !.
164
165
166pp(A) :-
167 print_term(A, [indent_arguments(2),tab_width(0)]).
168
169tree(Body, In, Tree) :-
170 tree(Body, In, Tree, []).
171
172tree(Body, In, Tree, Rest) :-
173 Body =.. BodyList,
174 append(BodyList, [Tree], BodyWithResList),
175 BodyWithRes =.. BodyWithResList,
176 phrase(BodyWithRes, In, Rest).
177
178tree_from_file(Body, Filename, Tree) :-
179 read_file_to_codes(Filename, Codes, []),
180 maplist(char_code, Chars, Codes),
181 tree(Body, Chars, Tree).
182
183
184:- discontiguous tokens/4, tokens/5. 185
186test_tokens(file(File), Tokens, Opts) :-
187 open(File, read, Stream),
188 read_string(Stream, _Length, String),
189 string_chars(String, Chars),
190 tokens(Opts, Tokens, Chars).
191
192tokens(Opts, Tokens, A) :-
193 nonvar(Tokens),
194 !,
195 phrase(plammar:term(Opts, term(Tokens)), A, []).
196
197tokens(Opts, Tokens, A) :-
198 var(Tokens),
199 !,
200 tokens(Opts, prolog, Tokens, A, nil),
201 !.
205tokens(Opts0, prolog, [shebang(['#','!',PT_Comment_Text,NLC_Tree])|Tokens], ['#','!'|A], nil) :-
206 !,
207 option(allow_shebang(Allow_Shebang), Opts0, no),
208 yes(Allow_Shebang),
209 merge_options([disallow_chars(['\n'])], Opts0, Opts),
210 comment_text(Opts, PT_Comment_Text, A, B),
211 ( B = [] ->
212 NLC_Tree = end_of_file,
213 Tokens = []
214 ; otherwise ->
215 new_line_char(NLC_Tree, B, C),
216 tokens(Opts0, lts, Tokens, C, DL-DL)
217 ).
218
219tokens(Opts, prolog, Tokens, A, nil) :-
220 tokens(Opts, lts, Tokens, A, DL-DL).
224tokens(Opts, lts, Tokens, A, LTS0-L0) :-
225 ( A = [] ->
226 ( L0 == LTS0 ->
227 Tokens = []
228 ; otherwise ->
229 L0 = [],
230 Tokens = [layout_text_sequence(LTS0)]
231 )
232 ; layout_char(PT_Layout_Char, A, B) ->
233 L0 = [layout_text(PT_Layout_Char)|E1],
234 tokens(Opts, lts, Tokens, B, LTS0-E1)
235 ; comment_open(PT_Comment_Open, A, B) ->
236 tokens(Opts, bracketed_comment(LTS0-L0,DL-DL,B), Tokens, PT_Comment_Open, B)
237 ; end_line_comment_char(PT_End_Line_Comment_Char, A, B) ->
238 tokens(Opts, single_line_comment(LTS0-L0,DL-DL,B), Tokens, PT_End_Line_Comment_Char, B)
239 ; otherwise ->
240 L0 = [],
241 tokens(Opts, token, Tokens, A, LTS0)
242 ).
245tokens(Opts, token, [Token|Tokens], A, LTS) :-
246 ( 247 A = ['0'|B],
248 single_quote_char(PT_Single_Quote_Char, B, C) ->
249 tokens(Opts, character_code_constant(PT,Tag,A), Tokens, PT_Single_Quote_Char, C)
250 ; 251 A = ['0', 'b'|B],
252 binary_digit_char(PT_Binary_Digit_Char, B, C) ->
253 tokens(Opts, binary_constant(PT,Tag,A), Tokens, PT_Binary_Digit_Char, C)
254 ; 255 A = ['0', 'o'|B],
256 octal_digit_char(PT_Octal_Digit_Char, B, C) ->
257 tokens(Opts, octal_constant(PT,Tag,A), Tokens, PT_Octal_Digit_Char, C)
258 ; 259 A = ['0', 'x'|B],
260 hexadecimal_digit_char(PT_Hexadecimal_Char, B, C) ->
261 tokens(Opts, hexadecimal_constant(PT,Tag,A), Tokens, PT_Hexadecimal_Char, C)
262 ; 263 decimal_digit_char(PT_Decimal_Digit_Char, A, B),
264 tokens(Opts, number_token(PT,Tag,A), Tokens, [PT_Decimal_Digit_Char], B)
265 ; 266 small_letter_char(Opts, PT_Small_Letter_Char, A, B) ->
267 tokens(Opts, name_token(PT,A), Tokens, PT_Small_Letter_Char, B),
268 Tag = name
269 ; 270 capital_letter_char(Opts, PT_Capital_Letter_Char, A, B) ->
271 option(var_prefix(Var_Prefix), Opts),
272 ( no(Var_Prefix) ->
273 tokens(Opts, capital_variable(PT,A), Tokens, PT_Capital_Letter_Char, B),
274 Tag = variable
275 ; yes(Var_Prefix) ->
276 tokens(Opts, name_token(PT,A), Tokens, PT_Capital_Letter_Char, B),
277 Tag = name
278 )
279 ; 280 variable_indicator_char(PT_Variable_Indicator_Char, A, B) ->
281 tokens(Opts, underscore_variable(PT,A), Tokens, PT_Variable_Indicator_Char, B),
282 Tag = variable
283 ; 284 comma_char(PT_Comma_Char, A, B) ->
285 PT = comma_token(PT_Comma_Char),
286 Tag = comma,
287 tokens(Opts, lts, Tokens, B, DL-DL)
288 ; 289 head_tail_separator_char(PT_Ht_Sep_Char, A, B) ->
290 PT = head_tail_separator_token(PT_Ht_Sep_Char),
291 Tag = ht_sep,
292 tokens(Opts, lts, Tokens, B, DL-DL)
293 ; 294 open_list_char(PT_Open_List_Char, A, B) ->
295 PT = open_list_token(PT_Open_List_Char),
296 Tag = open_list,
297 tokens(Opts, lts, Tokens, B, DL-DL)
298 ; 299 close_list_char(PT_Close_List_Char, A, B) ->
300 PT = close_list_token(PT_Close_List_Char),
301 Tag = close_list,
302 tokens(Opts, lts, Tokens, B, DL-DL)
303 ; 304 open_curly_char(PT_Open_Curly_Char, A, B) ->
305 PT = open_curly_token(PT_Open_Curly_Char),
306 Tag = open_curly,
307 tokens(Opts, lts, Tokens, B, DL-DL)
308 ; 309 close_curly_char(PT_Close_Curly_Char, A, B) ->
310 PT = close_curly_token(PT_Close_Curly_Char),
311 Tag = close_curly,
312 tokens(Opts, lts, Tokens, B, DL-DL)
313 ; 314 double_quote_char(PT_Double_Quote_Char, A, B) ->
315 tokens(Opts, double_quoted_list(PT,B), Tokens, PT_Double_Quote_Char, B),
316 Tag = double_quoted_list
317 ; 318 single_quote_char(PT_Single_Quote_Char, A, B) ->
319 tokens(Opts, quoted_token(PT,A), Tokens, PT_Single_Quote_Char, B),
320 Tag = name
321 ; 322 back_quote_char(PT_Back_Quote_Char, A, B),
323 option(back_quoted_text(Back_Quoted_Text), Opts),
324 yes(Back_Quoted_Text) ->
325 tokens(Opts, back_quoted_string(PT,B), Tokens, PT_Back_Quote_Char, B),
326 Tag = back_quoted_string
327 ; 328 semicolon_char(PT_Semicolon_Char, A, B) ->
329 PT = name_token(';', semicolon_token(PT_Semicolon_Char)),
330 Tag = name,
331 tokens(Opts, lts, Tokens, B, DL-DL)
332 ; 333 cut_char(PT_Cut_Char, A, B) ->
334 PT = name_token('!', cut_token(PT_Cut_Char)),
335 Tag = name,
336 tokens(Opts, lts, Tokens, B, DL-DL)
337 ; 338 graphic_token_char(Opts, PT_Graphic_Token_Char, A, B) ->
339 tokens(Opts, graphic_token(PT_Graphic_Token,A), Tokens, PT_Graphic_Token_Char, B),
341
342
343 ( PT_Graphic_Token = name_token('.', _),
344 ( layout_char(_, B, _) ; B = ['%'|_] ; B = [] ) ->
345 Tag = end,
346 PT = end_token(end_char('.'))
347 ; otherwise ->
348 Tag = name,
349 PT = PT_Graphic_Token
350 )
351 ; 352 open_char(PT_Open_Char, A, B) ->
353 PT = open_token(PT_Open_Char),
354 ( LTS = [] ->
355 Tag = open_ct
356 ; otherwise ->
357 Tag = open
358 ),
359 tokens(Opts, lts, Tokens, B, DL-DL)
360 ; 361 close_char(PT_Close_Char, A, B) ->
362 PT = close_token(PT_Close_Char),
363 Tag = close,
364 tokens(Opts, lts, Tokens, B, DL-DL)
365 )
365,
366 ( Tag = open_ct ->
367 Token =.. [Tag, PT]
368 ; LTS = [] ->
369 Token =.. [Tag, [PT]]
370 ; otherwise ->
371 Token =.. [Tag, [layout_text_sequence(LTS), PT]]
372 )
372.
373
375tokens(Opts, character_code_constant(PT,Tag,Beg), Tokens, PT_Single_Quote_Char, A) :-
376 ( single_quoted_character(Opts, PT_Single_Quoted_Character, A, B)
377 ; option(allow_single_quote_char_in_character_code_constant(Allow_Single_Quote_Char_In_Character_Code_Constant), Opts, no),
378 yes(Allow_Single_Quote_Char_In_Character_Code_Constant),
379 A = ['\''|B],
380 PT_Single_Quoted_Character = single_quoted_character(single_quote_char('\''))
381 ),
382 PT = integer_token(Atom, character_code_constant([
383 '0',
384 PT_Single_Quote_Char,
385 PT_Single_Quoted_Character
386 ])),
387 Tag = integer,
388 append(Cons, B, Beg),
389 atom_chars(Atom, Cons),
390 tokens(Opts, lts, Tokens, B, DL-DL).
393tokens(Opts, binary_constant(PT,Tag,Beg), Tokens, PT_Binary_Digit_Char, A) :-
394 PT = integer_token(Atom, binary_constant([
395 binary_constant_indicator(['0', 'b']),
396 PT_Binary_Digit_Char|
397 Ls
398 ])),
399 tokens(Opts, seq_binary_digit_char(Ls,Beg,Cons), Tokens, A),
400 atom_chars(Atom, Cons),
401 Tag = integer.
404tokens(Opts, octal_constant(PT,Tag,Beg), Tokens, PT_Octal_Digit_Char, A) :-
405 PT = integer_token(Atom, octal_constant([
406 octal_constant_indicator(['0', 'o']),
407 PT_Octal_Digit_Char|
408 Ls
409 ])),
410 tokens(Opts, seq_octal_digit_char(Ls,Beg,Cons), Tokens, A),
411 atom_chars(Atom, Cons),
412 Tag = integer.
415tokens(Opts, hexadecimal_constant(PT,Tag,Beg), Tokens, PT_Hexadecimal_Char, A) :-
416 PT = integer_token(Atom, hexadecimal_constant([
417 hexadecimal_constant_indicator(['0', 'x']),
418 PT_Hexadecimal_Char|
419 Ls
420 ])),
421 tokens(Opts, seq_hexadecimal_digit_char(Ls,Beg,Cons), Tokens, A),
422 atom_chars(Atom, Cons),
423 Tag = integer.
426tokens(Opts, number_token(PT,Tag,Beg), Tokens, Ls0, A) :-
427 ( decimal_digit_char(PT_Decimal_Digit_Char, A, B) ->
428 append(Ls0, [PT_Decimal_Digit_Char], Ls1),
429 tokens(Opts, number_token(PT,Tag,Beg), Tokens, Ls1, B)
430 ; underscore_char(PT_Underscore_Char, A, B),
431 option(allow_digit_groups_with_underscore(Allow_Digit_Groups_With_Underscore), Opts, no),
432 yes(Allow_Digit_Groups_With_Underscore) ->
433 ( decimal_digit_char(PT_Decimal_Digit_Char, B, D) ->
434 append(Ls0, [PT_Underscore_Char, PT_Decimal_Digit_Char], Ls1)
435 ; bracketed_comment(Opts, PT_Bracketed_Comment, B, C),
436 decimal_digit_char(PT_Decimal_Digit_Char, C, D) ->
437 append(Ls0, [PT_Underscore_Char, PT_Bracketed_Comment, PT_Decimal_Digit_Char], Ls1)
438 ),
439 tokens(Opts, number_token(PT,Tag,Beg), Tokens, Ls1, D)
440 ; space_char(PT_Space_Char, A, B),
441 option(allow_digit_groups_with_space(Allow_Digit_Groups_With_Space), Opts, no),
442 yes(Allow_Digit_Groups_With_Space),
443 decimal_digit_char(PT_Decimal_Digit_Char, B, C) ->
444 append(Ls0, [PT_Space_Char, PT_Decimal_Digit_Char], Ls1),
445 tokens(Opts, number_token(PT,Tag,Beg), Tokens, Ls1, C)
446 ; decimal_point_char(PT_Decimal_Point_Char, A, B),
447 decimal_digit_char(PT_Decimal_Digit_Char, B, C) ->
448 PT = float_number_token(Atom, [integer_constant(Ls0), fraction([PT_Decimal_Point_Char, PT_Decimal_Digit_Char|Ls])|Exponent]),
449 Tag = float_number,
450 tokens(Opts, fraction(Ls,Exponent,Beg,Cons), Tokens, C),
451 atom_chars(Atom, Cons)
452 ; exponent_char(PT_Exponent_Char, A, B),
453 option(allow_integer_exponential_notation(Allow_Integer_Exponential_Notation), Opts, no),
454 yes(Allow_Integer_Exponential_Notation),
455 sign(PT_Sign, B, C),
456 decimal_digit_char(PT_Decimal_Digit_Char, C, D) ->
457 PT = float_number_token(Atom, [integer_constant(Ls0)|Exponent]),
458 Tag = float_number,
459 Exponent = [exponent([PT_Exponent_Char,PT_Sign,integer_constant([PT_Decimal_Digit_Char|Rs])])],
460 tokens(Opts, seq_decimal_digit_char(Rs,Beg,Cons), Tokens, D),
461 atom_chars(Atom, Cons)
462 ; otherwise ->
463 Tag = integer,
464 append(Cons, A, Beg),
465 atom_chars(Atom, Cons),
466 PT = integer_token(Atom, integer_constant(Ls0)),
467 tokens(Opts, lts, Tokens, A, DL-DL)
468 ).
471tokens(_Opts, fraction([],[],Beg,Beg), [], []) :-
472 !.
473tokens(Opts, fraction(Ls,Exponent,Beg,Cons), Tokens, A) :-
474 ( decimal_digit_char(PT_Decimal_Digit_Char, A, B) ->
475 Ls = [PT_Decimal_Digit_Char|PTs],
476 tokens(Opts, fraction(PTs,Exponent,Beg,Cons), Tokens, B)
477 ; exponent_char(PT_Exponent_Char, A, B),
478 sign(PT_Sign, B, C),
479 decimal_digit_char(PT_Decimal_Digit_Char, C, D) ->
480 Ls = [],
481 Exponent = [exponent([PT_Exponent_Char,PT_Sign,integer_constant([PT_Decimal_Digit_Char|Rs])])],
482 tokens(Opts, seq_decimal_digit_char(Rs,Beg,Cons), Tokens, D)
483 ; otherwise ->
484 append(Cons, A, Beg),
485 tokens(Opts, lts, Tokens, A, DL-DL),
486 Ls = [],
487 Exponent = []
488 ).
491tokens(Opts, double_quoted_list(PT,Beg), Tokens, PT_Double_Quote_Char, A) :-
492 PT = double_quoted_list_token(Atom, [PT_Double_Quote_Char|Ls]),
493 tokens(Opts, seq_double_quoted_item(Ls,Beg,Cons), Tokens, A),
494 atom_chars(Atom, Cons).
497tokens(Opts, quoted_token(PT,Beg), Tokens, PT_Single_Quote_Char, A) :-
498 PT = name_token(Atom, quoted_token([PT_Single_Quote_Char|Ls])),
499 tokens(Opts, seq_single_quoted_item(Ls,Beg,Cons), Tokens, A),
500 atom_chars(Atom, Cons).
503tokens(Opts, back_quoted_string(PT,Beg), Tokens, PT_Back_Quote_Char, A) :-
504 PT = back_quoted_string_token(Atom, [PT_Back_Quote_Char|Ls]),
505 tokens(Opts, seq_back_quoted_item(Ls,Beg,Cons), Tokens, A),
506 atom_chars(Atom, Cons).
509tokens(Opts, name_token(PT,Beg), Tokens, PT_Small_Letter_Char, A) :-
510 PT = name_token(Atom, letter_digit_token([PT_Small_Letter_Char|Ls])),
511 tokens(Opts, seq_alphanumeric_char(Ls,Beg,Cons), Tokens, A),
512 atom_chars(Atom, Cons).
515tokens(Opts, capital_variable(PT,Beg), Tokens, PT_Capital_Letter_Char, A) :-
516 PT = variable_token(Atom, named_variable([PT_Capital_Letter_Char|Ls])),
517 tokens(Opts, seq_alphanumeric_char(Ls,Beg,Cons), Tokens, A),
518 atom_chars(Atom, Cons).
521tokens(Opts, underscore_variable(PT,Beg), Tokens, PT_Variable_Indicator_Char, A) :-
522 tokens(Opts, seq_alphanumeric_char(Ls,Beg,Cons), Tokens, A),
523 ( Ls = [] ->
524 PT = variable_token('_', anonymous_variable(PT_Variable_Indicator_Char)),
525 Beg = _ 526 ; otherwise ->
527 PT = variable_token(Atom, named_variable([PT_Variable_Indicator_Char|Ls])),
528 atom_chars(Atom, Cons)
529 ).
532tokens(Opts, graphic_token(PT,Beg), Tokens, PT_Graphic_Token_Char, A) :-
533 PT = name_token(Atom, graphic_token([PT_Graphic_Token_Char|Ls])),
534 tokens(Opts, seq_graphic_token_char(Ls,Beg,Cons), Tokens, A),
535 atom_chars(Atom, Cons).
538tokens(Opts, bracketed_comment(LTS0-L0,CT-[],Beg), Tokens, PT_Comment_Open, ['*','/'|A]) :-
539 !,
540 append(Cons, ['*','/'|A], Beg),
541 atom_chars(Atom, Cons),
542 PT = layout_text(comment(bracketed_comment([
543 PT_Comment_Open,
544 comment_text(Atom, CT),
545 comment_close([
546 comment_2_char('*'),
547 comment_1_char('/')
548 ])
549 ]))),
550 L0 = [PT|L1],
551 tokens(Opts, lts, Tokens, A, LTS0-L1).
552
553tokens(Opts, bracketed_comment(LTS0-L0,CT0-E0,Beg), Tokens, PT_Comment_Open, A) :-
554 char(Opts, PT_Char, A, B),
555 E0 = [PT_Char|E1],
556 tokens(Opts, bracketed_comment(LTS0-L0,CT0-E1,Beg), Tokens, PT_Comment_Open, B).
559tokens(Opts, single_line_comment(LTS0-L0,CT0-E0,Beg), Tokens, PT_End_Line_Comment_Char, A) :-
560 ( A = [] ->
561 append(Cons, A, Beg),
562 atom_chars(Atom, Cons),
563 E0 = [],
564 PT = layout_text(comment(single_line_comment([
565 PT_End_Line_Comment_Char,
566 comment_text(Atom, CT0),
567 end_of_file
568 ]))),
569 L0 = [PT|L1],
570 tokens(Opts, lts, Tokens, [], LTS0-L1)
571 ; new_line_char(PT_New_Line_Char, A, B) ->
572 append(Cons, A, Beg),
573 atom_chars(Atom, Cons),
574 E0 = [],
575 PT = layout_text(comment(single_line_comment([
576 PT_End_Line_Comment_Char,
577 comment_text(Atom, CT0),
578 PT_New_Line_Char
579 ]))),
580 L0 = [PT|L1],
581 tokens(Opts, lts, Tokens, B, LTS0-L1)
582 ; char(Opts, PT_Char, A, B) ->
583 E0 = [PT_Char|E1],
584 tokens(Opts, single_line_comment(LTS0-L0,CT0-E1,Beg), Tokens, PT_End_Line_Comment_Char, B)
585 ).
588tokens(_Opts, seq_alphanumeric_char([],Beg,Beg), [], []) :-
589 !.
590tokens(Opts, seq_alphanumeric_char(Ls,Beg,Cons), Tokens, A) :-
591 ( alphanumeric_char(Opts, PT_Alphanumeric_Char, A, B) ->
592 tokens(Opts, seq_alphanumeric_char(PTs,Beg,Cons), Tokens, B),
593 Ls = [PT_Alphanumeric_Char|PTs]
594 ; otherwise ->
595 append(Cons, A, Beg),
596 tokens(Opts, lts, Tokens, A, DL-DL),
597 Ls = []
598 ).
601tokens(_Opts, seq_graphic_token_char([],Beg,Beg), [], []) :-
602 !.
603tokens(Opts, seq_graphic_token_char(Ls,Beg,Cons), Tokens, A) :-
604 ( graphic_token_char(Opts, PT_Graphic_Token_Char, A, B) ->
605 tokens(Opts, seq_graphic_token_char(PTs,Beg,Cons), Tokens, B),
606 Ls = [PT_Graphic_Token_Char|PTs]
607 ; otherwise ->
608 append(Cons, A, Beg),
609 tokens(Opts, lts, Tokens, A, DL-DL),
610 Ls = []
611 ).
614tokens(_Opts, seq_decimal_digit_char([],Beg,Beg), [], []) :-
615 !.
616tokens(Opts, seq_decimal_digit_char(Ls,Beg,Cons), Tokens, A) :-
617 ( decimal_digit_char(PT_Decimal_Digit_Char, A, B) ->
618 tokens(Opts, seq_decimal_digit_char(PTs,Beg,Cons), Tokens, B),
619 Ls = [PT_Decimal_Digit_Char|PTs]
620 ; otherwise ->
621 append(Cons, A, Beg),
622 tokens(Opts, lts, Tokens, A, DL-DL),
623 Ls = []
624 ).
627tokens(Opts, seq_double_quoted_item(Ls,Beg,Cons), Tokens, A) :-
628 ( double_quoted_item(Opts, PT_Double_Quoted_Item, A, B) ->
629 tokens(Opts, seq_double_quoted_item(PTs,Beg,Cons), Tokens, B),
630 Ls = [PT_Double_Quoted_Item|PTs]
631 ; double_quote_char(PT_Double_Quote_Char, A, B) ->
632 append(Cons, A, Beg),
633 tokens(Opts, lts, Tokens, B, DL-DL),
634 Ls = [PT_Double_Quote_Char]
635 ).
638tokens(Opts, seq_back_quoted_item(Ls,Beg,Cons), Tokens, A) :-
639 ( back_quoted_item(Opts, PT_Back_Quoted_Item, A, B) ->
640 tokens(Opts, seq_back_quoted_item(PTs,Beg,Cons), Tokens, B),
641 Ls = [PT_Back_Quoted_Item|PTs]
642 ; back_quote_char(PT_Back_Quote_Char, A, B) ->
643 append(Cons, A, Beg),
644 tokens(Opts, lts, Tokens, B, DL-DL),
645 Ls = [PT_Back_Quote_Char]
646 ).
649tokens(Opts, seq_single_quoted_item(Ls,Beg,Cons), Tokens, A) :-
650 ( single_quoted_item(Opts, PT_Single_Quoted_Item, A, B) ->
651 tokens(Opts, seq_single_quoted_item(PTs,Beg,Cons), Tokens, B),
652 Ls = [PT_Single_Quoted_Item|PTs]
653 ; single_quote_char(PT_Single_Quote_Char, A, B) ->
654 append(Cons, B, Beg),
655 tokens(Opts, lts, Tokens, B, DL-DL),
656 Ls = [PT_Single_Quote_Char]
657 ).
660tokens(_Opts, seq_binary_digit_char([],Beg,Beg), [], []) :-
661 !.
662tokens(Opts, seq_binary_digit_char(Ls,Beg,Cons), Tokens, A) :-
663 ( binary_digit_char(PT_Binary_Digit_Char, A, B) ->
664 tokens(Opts, seq_binary_digit_char(PTs,Beg,Cons), Tokens, B),
665 Ls = [PT_Binary_Digit_Char|PTs]
666 ; underscore_char(PT_Underscore_Char, A, B),
667 option(allow_digit_groups_with_underscore(Allow_Digit_Groups_With_Underscore), Opts, no),
668 yes(Allow_Digit_Groups_With_Underscore) ->
669 ( binary_digit_char(PT_Binary_Digit_Char, B, D) ->
670 Ls = [PT_Underscore_Char, PT_Binary_Digit_Char|PTs]
671 ; bracketed_comment(Opts, PT_Bracketed_Comment, B, C),
672 binary_digit_char(PT_Binary_Digit_Char, C, D) ->
673 Ls = [PT_Underscore_Char, PT_Bracketed_Comment, PT_Binary_Digit_Char|PTs]
674 ),
675 tokens(Opts, seq_binary_digit_char(PTs,Beg,Cons), Tokens, D)
676 ; space_char(PT_Space_Char, A, B),
677 option(allow_digit_groups_with_space(Allow_Digit_Groups_With_Space), Opts, no),
678 yes(Allow_Digit_Groups_With_Space),
679 binary_digit_char(PT_Binary_Digit_Char, B, C) ->
680 Ls = [PT_Space_Char, PT_Binary_Digit_Char|PTs],
681 tokens(Opts, seq_binary_digit_char(PTs,Beg,Cons), Tokens, C)
682 ; otherwise ->
683 append(Cons, A, Beg),
684 tokens(Opts, lts, Tokens, A, DL-DL),
685 Ls = []
686 ).
689tokens(_Opts, seq_octal_digit_char([],Beg,Beg), [], []) :-
690 !.
691tokens(Opts, seq_octal_digit_char(Ls,Beg,Cons), Tokens, A) :-
692 ( octal_digit_char(PT_Octal_Digit_Char, A, B) ->
693 tokens(Opts, seq_octal_digit_char(PTs,Beg,Cons), Tokens, B),
694 Ls = [PT_Octal_Digit_Char|PTs]
695 ; underscore_char(PT_Underscore_Char, A, B),
696 option(allow_digit_groups_with_underscore(Allow_Digit_Groups_With_Underscore), Opts, no),
697 yes(Allow_Digit_Groups_With_Underscore) ->
698 ( octal_digit_char(PT_Octal_Digit_Char, B, D) ->
699 Ls = [PT_Underscore_Char, PT_Octal_Digit_Char|PTs]
700 ; bracketed_comment(Opts, PT_Bracketed_Comment, B, C),
701 octal_digit_char(PT_Octal_Digit_Char, C, D) ->
702 Ls = [PT_Underscore_Char, PT_Bracketed_Comment, PT_Octal_Digit_Char|PTs]
703 ),
704 tokens(Opts, seq_octal_digit_char(PTs,Beg,Cons), Tokens, D)
705 ; space_char(PT_Space_Char, A, B),
706 option(allow_digit_groups_with_space(Allow_Digit_Groups_With_Space), Opts, no),
707 yes(Allow_Digit_Groups_With_Space),
708 octal_digit_char(PT_Octal_Digit_Char, B, C) ->
709 Ls = [PT_Space_Char, PT_Octal_Digit_Char|PTs],
710 tokens(Opts, seq_octal_digit_char(PTs,Beg,Cons), Tokens, C)
711 ; otherwise ->
712 append(Cons, A, Beg),
713 tokens(Opts, lts, Tokens, A, DL-DL),
714 Ls = []
715 ).
718tokens(_Opts, seq_hexadecimal_digit_char([],Beg,Beg), [], []) :-
719 !.
720tokens(Opts, seq_hexadecimal_digit_char(Ls,Beg,Cons), Tokens, A) :-
721 ( hexadecimal_digit_char(PT_Hexadecimal_Digit_Char, A, B) ->
722 tokens(Opts, seq_hexadecimal_digit_char(PTs,Beg,Cons), Tokens, B),
723 Ls = [PT_Hexadecimal_Digit_Char|PTs]
724 ; underscore_char(PT_Underscore_Char, A, B),
725 option(allow_digit_groups_with_underscore(Allow_Digit_Groups_With_Underscore), Opts, no),
726 yes(Allow_Digit_Groups_With_Underscore) ->
727 ( hexadecimal_digit_char(PT_Hexadecimal_Digit_Char, B, D) ->
728 Ls = [PT_Underscore_Char, PT_Hexadecimal_Digit_Char|PTs]
729 ; bracketed_comment(Opts, PT_Bracketed_Comment, B, C),
730 hexadecimal_digit_char(PT_Hexadecimal_Digit_Char, C, D) ->
731 Ls = [PT_Underscore_Char, PT_Bracketed_Comment, PT_Hexadecimal_Digit_Char|PTs]
732 ),
733 tokens(Opts, seq_hexadecimal_digit_char(PTs,Beg,Cons), Tokens, D)
734 ; space_char(PT_Space_Char, A, B),
735 option(allow_digit_groups_with_space(Allow_Digit_Groups_With_Space), Opts, no),
736 yes(Allow_Digit_Groups_With_Space),
737 hexadecimal_digit_char(PT_Hexadecimal_Digit_Char, B, C) ->
738 Ls = [PT_Space_Char, PT_Hexadecimal_Digit_Char|PTs],
739 tokens(Opts, seq_hexadecimal_digit_char(PTs,Beg,Cons), Tokens, C)
740 ; otherwise ->
741 append(Cons, A, Beg),
742 tokens(Opts, lts, Tokens, A, DL-DL),
743 Ls = []
744 ).
751token(Opts, Tree, In, Rest) :-
752 nonvar(In), !,
753 token_(Opts, token_(Tree), In, Rest),
754 Some_More_Elements = [_|_], 755 \+((
756 token_(Opts, _, In, Shorter_Rest),
757 append(Some_More_Elements, Shorter_Rest, Rest)
758 )).
759token(Opts, Tree, In, Rest) :-
760 nonvar(Tree), !,
761 token_(Opts, token_(Tree), In, Rest).
762token(_Opts, Tree, In, Rest) :-
763 var(Tree), var(In), !,
764 warning('Parse tree AND input unbound; this might not work as expected!'),
765 token_(token_(Tree), In, Rest).
766
767:- op(600, xfx, token). 768:- discontiguous plammar:token/4. 769
770term_expansion(X1 token Opts --> Y1, [Rule]) :-
771 atom_concat(X1, '_token', X1_token),
772 X1_token_with_Opts =.. [X1_token, Opts],
773 dcg4pt:dcg4pt_rule_to_dcg_rule(X1_token_with_Opts --> Y1, X2 --> Y2),
774 dcg_translate_rule(X2 --> Y2, Expanded_DCG_Rule),
775 Expanded_DCG_Rule = (
776 Expanded_DCG_Rule_Head :-
777 Expanded_DCG_Rule_Body
778 ),
779 Expanded_DCG_Rule_Head =.. [X1_token, Opts, Initial_Tree, In, Out],
780 Initial_Tree =.. [X1_token, Inner_Tree],
781 New_DCG_Rule_Head =.. [X1_token, Opts, New_Tree, In, Out],
782 New_Tree =.. [X1_token, Consumed, Inner_Tree],
783 Rule = (
784 New_DCG_Rule_Head :-
785 Expanded_DCG_Rule_Body,
786 ( var(Consumed) ->
787 append(Consumed_Chars, Out, In),
788 atom_chars(Consumed, Consumed_Chars)
789 ; true )
790 ).
791
792:- op(600, xf, wrap_text). 793
794term_expansion(Head wrap_text --> Y1, [Rule]) :-
795 dcg4pt:dcg4pt_rule_to_dcg_rule(Head --> Y1, X2 --> Y2),
796 dcg_translate_rule(X2 --> Y2, Expanded_DCG_Rule),
797 Expanded_DCG_Rule = (
798 Expanded_DCG_Rule_Head :-
799 Expanded_DCG_Rule_Body
800 ),
801 Expanded_DCG_Rule_Head =.. [X1_token, Opts, Initial_Tree, In, Out],
802 Initial_Tree =.. [X1_token, Inner_Tree],
803 New_DCG_Rule_Head =.. [X1_token, Opts, New_Tree, In, Out],
804 New_Tree =.. [X1_token, Consumed, Inner_Tree],
805 Rule = (
806 New_DCG_Rule_Head :-
807 Expanded_DCG_Rule_Body,
808 ( var(Consumed) ->
809 append(Consumed_Chars, Out, In),
810 atom_chars(Consumed, Consumed_Chars)
811 ; true )
812 ).
813
814term_expansion(X1 --> Y1, [Rule]) :-
815 dcg4pt:dcg4pt_rule_to_dcg_rule(X1 --> Y1, X2 --> Y2),
816 dcg_translate_rule(X2 --> Y2, Rule).
817
830:- op(800, fy, *). 831*(DCGBody, Tree, In, Out) :-
832 833 nonvar(In), !,
834 835 sequence('**', DCGBody, Tree, In, Out).
836*(DCGBody, Tree, In, Out) :-
837 838 var(In), !,
839 840 sequence('*', DCGBody, Tree, In, Out).
843:- op(800, fy, ?). 844?(DCGBody, Tree, In, Out) :-
845 sequence('?', DCGBody, Tree, In, Out).
846
847:- load_files('plammar/dcg_token.pl', [module(plammar)]). 848:- load_files('parser.pl', [module(plammar)]).