1:- module('plammar/format_space', [
2 layout/5,
3 quoted_items/5
4 ]). 5
6:- use_module(library(lists), [append/3, member/2]). 7:- use_module(library(option), [option/2]). 8
9:- use_module(state). 10:- use_module(util). 11:- use_module(options). 12:- use_module(format_check). 13
14layout(Opts, S0, SN, [PT], PT) :-
15 leading_layout(Opts, S0, SN, []).
16
17layout(Opts, S0, SN, [layout_text_sequence(PT_Layout_Text_Sequence),PT], PT) :-
18 leading_layout(Opts, S0, SN, PT_Layout_Text_Sequence).
19
20leading_layout(Opts, S0, SN, PT_Layout_Text_Sequence) :-
21 set_context(S0, S1, layout, [prev(null), newlines(0), leading_spaces(0), leading_tabs(0)]),
22 layout_spaces(Opts, S1, S2, PT_Layout_Text_Sequence),
23 del_context(S2, S2a, Context),
24 del_context(S2a, S4, layout, newlines(Newlines), 0),
25 get_context(S2, layout, leading_spaces(Spaces), 0),
26 ( Context = after_clause,
27 style_option(newline_after_clause(Newline_After_Clause/_), Opts),
28 yes(Newline_After_Clause),
29 Newlines = 0 ->
30 state_warn(S4, S5, [prop(newline_after_clause)]),
31 S6 = S5
32 ; Context = after_rule_op,
33 style_option(newline_after_rule_op(Newline_After_Rule_Op/_), Opts),
34 yes(Newline_After_Rule_Op),
35 Newlines = 0 ->
36 state_warn(S4, S5, [prop(newline_after_rule_op)]),
37 inc_context(S5, S6, layout, indent_level)
38 ; Context = after_subgoal,
39 style_option(newline_after_subgoal(Newline_After_Subgoal/_), Opts),
40 yes(Newline_After_Subgoal),
41 Newlines = 0 ->
42 state_warn(S4, S5, [prop(newline_after_subgoal)]),
43 S6 = S5
44 ; Context = after_arglist_comma,
45 style_option(space_after_arglist_comma(Space_After_Arglist_Comma/_), Opts),
46 yes(Space_After_Arglist_Comma),
47 Newlines = 0,
48 Spaces \= 1 ->
49 state_warn(S4, S5, [prop(space_after_arglist_comma), found(Spaces), expected(1)]),
50 S6 = S5
51 ; otherwise ->
52 S6 = S4
53 ),
54 ( Newlines > 0 ->
55 check(Opts, S6, S7, indent)
56 ; otherwise ->
57 S7 = S6
58 ),
59 SN = S7.
60
61layout_spaces(_Opts, SN, SN, []).
62layout_spaces(Opts, S0, SN, [PT|PTs]) :-
63 layout_space(Opts, S0, S1, PT),
64 layout_spaces(Opts, S1, SN, PTs).
65
(_Opts, SN, SN, []).
67comment_spaces(Opts, S0, SN, [PT|PTs]) :-
68 comment_space(Opts, S0, S1, PT),
69 comment_spaces(Opts, S1, SN, PTs).
70
71layout_space(_Opts, S0, SN, layout_text(layout_char(space_char(' ')))) :-
72 state_space(S0, S1, cols(1)),
73 set_context(S1, S2, layout, prev(space)),
74 inc_context(S2, SN, layout, leading_spaces).
75
76layout_space(_Opts, S0, SN, layout_text(layout_char(horizontal_tab_char('\t')))) :-
77 state_space(S0, S1, cols(1)),
78 set_context(S1, S2, layout, prev(tab)),
79 inc_context(S2, SN, layout, leading_tabs).
80
81layout_space(Opts, S0, SN, layout_text(layout_char(new_line_char(_)))) :-
82 check(Opts, S0, S2, max_line_length),
83 get_context(S0, layout, prev(Before)),
84 ( ( Before = space ; Before = space ),
85 style_option(no_eol_whitespace(No_EOL_Whitespace/_), Opts),
86 yes(No_EOL_Whitespace) ->
87 state_warn(S2, S3, [prop(no_eol_whitespace)])
88 ; otherwise ->
89 S3 = S2
90 ),
91 inc_context(S3, S4, layout, newlines),
92 state_space(S4, S5, rows(1)),
93 set_context(S5, S6, layout, prev(newline)),
94 95 set_context(S6, S7, layout, leading_spaces(0)),
96 set_context(S7, SN, layout, leading_tabs(0)).
97
98layout_space(Opts, S0, SN, layout_text(comment(single_line_comment(PTs)))) :-
99 PTs = [
100 end_line_comment_char('%'),
101 comment_text(CT, _),
102 new_line_char(_)
103 ],
104 state_space(S0, S1, cols(1)), 105 atom_length(CT, Length),
106 state_space(S1, S2, cols(Length)),
107 style_option(max_line_length(_/Secondary), Opts),
108 ( option(ignore(comments), Secondary) ->
109 S3 = S2
110 ; otherwise ->
111 check(Opts, S2, S3, max_line_length)
112 ),
113 inc_context(S3, S4, layout, newlines),
114 state_space(S4, S5, rows(1)),
115 116 set_context(S5, S6, layout, leading_spaces(0)),
117 set_context(S6, SN, layout, leading_tabs(0)).
118
119layout_space(Opts, S0, SN, layout_text(comment(bracketed_comment(PTs)))) :-
120 PTs = [
121 comment_open([
122 comment_1_char('/'),
123 comment_2_char('*')
124 ]),
125 comment_text(_CT, PTs_Comment_Text),
126 comment_close([
127 comment_2_char('*'),
128 comment_1_char('/')
129 ])
130 ],
131 comment_spaces(Opts, S0, SN, PTs_Comment_Text).
132
(Opts, S0, SN, char(layout_char(new_line_char(_)))) :-
134 !,
135 style_option(max_line_length(Max_Line_Length/Secondary), Opts),
136 ( \+ no(Max_Line_Length),
137 \+ option(ignore(comments), Secondary) ->
138 check(Opts, S0, S1, max_line_length)
139 ; otherwise ->
140 S1 = S0
141 ),
142 state_space(S1, SN, rows(1)).
143
144comment_space(_Opts, S0, SN, char(layout_char(horizontal_tab_char('\t')))) :-
145 !,
147 state_space(S0, SN, cols(1))
147.
148
149comment_space(_Opts, S0, SN, char(_)) :-
150 state_space(S0, SN, cols(1)).
151
152quoted_items(Opts0, S0, SN, Items, Atom) :-
153 154 normalise_options(prolog_parsetree, Opts0, Opts),
155 quoted_space(Opts, S0, SN, Items, Cs-Cs),
156 atom_chars(Atom, Cs).
157
158quoted_space(_Opts, S0, S0, [], _-[]).
159quoted_space(Opts, S0, SN, [PT|Rest], Cs0-Cs0e) :-
160 PT =.. [_X_Quoted_Item, PT_Quoted_Item],
161 PT_Quoted_Item =.. [Item, Inner],
162 quoted_space_item(Opts, S0, S1, Item, Inner, Cs0e, Cs1e),
163 quoted_space(Opts, S1, SN, Rest, Cs0-Cs1e).
164
165quoted_space_item(Opts, S0, SN, Character, Inner, Cs0e, Cs1e) :-
166 member(Character, [double_quoted_character, back_quoted_character, single_quoted_character]),
167 state_space(S0, S1, cols(1)), 168 PT =.. [Character, Inner],
169 Callable =.. [Character, Opts, PT, Chars, []],
170 plammar:Callable,
171 append(Chars, Cs1e, Cs0e),
172 ( Chars = [Char],
173 Char = '\t',
174 style_option(tab_in_quotes(Tab_In_Quotes/_), Opts),
175 no(Tab_In_Quotes) ->
176 state_warn(S1, S2, [prop(tab_in_quotes)])
177 ; otherwise ->
178 S2 = S1
179 ),
180 check_entity(Opts, S2, S3, symbolic_chars, Inner),
181 check_entity(Opts, S3, S4, missing_closing_backslash_in_character_escape, Inner),
182 check_entity(Opts, S4, S5, unicode_character_escape, Inner),
183 SN = S5.
184
185quoted_space_item(_Opts, S0, SN, continuation_escape_sequence, _Inner, Cs0e, Cs0e) :-
186 state_space(S0, SN, rows(1))