1:- module('plammar/format_check', [
2 check/4,
3 check_entity/5
4 ]). 5
6:- use_module(library(lists), [append/3, delete/3, member/2]). 7:- use_module(library(option), [option/2, option/3]). 8
9:- use_module(state). 10:- use_module(options). 11:- use_module(util). 12
13check(Opts, S0, SN, Prop) :-
14 What =.. [Prop, Value/Secondary],
15 style_option(What, Opts),
16 check(Opts, S0, SN, Prop, Value, Secondary).
17
18check(_Opts, S0, S0, _Prop, ignore, _Secondary) :-
19 20 true.
25check(_Opts, S0, S0, max_line_length, Integer, _Secondary) :-
26 integer(Integer),
27 option(pos(_:C0), S0),
28 ( C0 > Integer ->
29 writeln('too wide...')
30 ; otherwise ->
31 true
32 )
32.
33
34check(Opts, S0, SN, max_line_length, call(Goal), _Secondary) :-
35 option(pos(_:C0), S0),
36 Goal =.. [Pred|Args],
37 append([Opts, S0, SN|Args], [C0], All_Args),
38 Full_Goal =.. [Pred|All_Args],
39 call(Full_Goal).
44check(_Opts, S0, SN, indent, Integer, _Secondary) :-
45 integer(Integer),
46 get_context(S0, indent, level(Indent_Level), 0),
47 get_context(S0, layout, leading_spaces(Leading_Spaces), 0),
48 get_context(S0, layout, leading_tabs(Leading_Tabs), 0),
49 Expected is Indent_Level * Integer,
50 ( 51 Leading_Tabs > 0 ->
52 state_warn(S0, S1, [prop(indent_by_spaces)])
53 ; Leading_Spaces \= Expected ->
54 state_warn(S0, S1, [prop(indent), expected(Expected), found(Leading_Spaces)])
55 ; otherwise ->
56 S1 = S0
57 ),
58 SN = S1.
59
60check(_Opts, S0, SN, indent, '\t', _Secondary) :-
61 get_context(S0, indent, level(Indent_Level), 0),
62 get_context(S0, layout, leading_spaces(Leading_Spaces), 0),
63 get_context(S0, layout, leading_tabs(Leading_Tabs), 0),
64 Expected is Indent_Level,
65 ( 66 Leading_Spaces > 0 ->
67 state_warn(S0, S1, [prop(indent_by_tabs)])
68 ; Leading_Tabs \= Expected ->
69 state_warn(S0, S1, [prop(indent), expected(Expected), found(Leading_Tabs)])
70 ; otherwise ->
71 S1 = S0
72 ),
73 SN = S1.
74
75check(Opts, S0, SN, indent, call(Goal), _Secondary) :-
76 get_context(S0, indent, level(Indent_Level), 0),
77 get_context(S0, layout, leading_spaces(Leading_Spaces), 0),
78 get_context(S0, layout, leading_tabs(Leading_Tabs), 0),
79 Value = [
80 level(Indent_Level),
81 found_spaces(Leading_Spaces),
82 found_tabs(Leading_Tabs)
83 ],
84 Goal =.. [Pred|Args],
85 append([Opts, S0, SN|Args], [Value], All_Args),
86 Full_Goal =.. [Pred|All_Args],
87 call(Full_Goal).
92check(_Opts, S0, SN, dicts, Setting, _Secondary) :-
93 no(Setting),
94 state_warn(S0, SN, [prop(dict), msg('Avoid using dicts')]).
95check(_Opts, S0, S0, dicts, _Setting, _Secondary).
100check(_Opts, S0, SN, compounds_with_zero_arguments, Setting, _Secondary) :-
101 no(Setting),
102 state_warn(S0, SN, [prop(compounds_with_zero_arguments)]).
103check(_Opts, S0, S0, compounds_with_zero_arguments, _Setting, _Secondary).
107check(_Opts, S0, SN, shebang, Setting, _Secondary) :-
108 no(Setting),
109 state_warn(S0, SN, [prop(shebang)]).
110check(_Opts, S0, S0, shebang, _Setting, _Secondary).
115check(_Opts, S0, S0, Prop, Value, _) :-
116 warning('Unknown value "~w" for checked property "~w".', [Value, Prop]),
117 !.
118
119
120check_entity(Opts, S0, SN, Prop, Entity) :-
121 What =.. [Prop, Value/Secondary],
122 style_option(What, Opts),
123 check_entity(Opts, S0, SN, Prop, Value, Secondary, Entity).
124
125check_entity(_Opts, S0, S0, _Prop, ignore, _Secondary, _Entity) :-
126 127 true.
132check_entity(_Opts, S0, S0, max_subgoals, inf, _Secondary, _Entity).
133
134check_entity(Opts, S0, SN, max_subgoals, call(Goal), _Secondary, Subgoals) :-
135 length(Subgoals, Length),
136 Goal =.. [Pred|Args],
137 append([Opts, S0, SN|Args], [Length], All_Args),
138 Full_Goal =.. [Pred|All_Args],
139 once(call(Full_Goal)).
144check_entity(_Opts, S0, S0, max_rule_lines, inf, _Secondary, _Entity).
145
146check_entity(Opts, S0, SN, max_rule_lines, call(Goal), _Secondary, [S_Begin, S_End]) :-
147 option(pos(L0:_), S_Begin),
148 option(pos(L1:_), S_End),
149 Length is L1-L0,
150 Goal =.. [Pred|Args],
151 append([Opts, S0, SN|Args], [Length], All_Args),
152 Full_Goal =.. [Pred|All_Args],
153 once(call(Full_Goal)).
158check_entity(Opts, S0, SN, integer_exponential_notation, Setting, _Secondary, PT_Float_Number_Token) :-
159 PT_Float_Number_Token = [integer_constant(PT_Integer_Constant), exponent(PT_Exponent)],
160 no(Setting),
161 plammar:float_number_token(Opts, float_number_token(Found, PT_Float_Number_Token), _, []),
162 plammar:float_number_token(Opts, float_number_token(Expected, [integer_constant(PT_Integer_Constant), fraction([decimal_point_char('.'), decimal_digit_char('0')]), exponent(PT_Exponent)]), _, []),
163 use_msg(Found, Expected, Msg, 'for ISO conformity'),
164 state_warn(S0, SN, [prop(integer_exponential_notation), msg(Msg)]).
165check_entity(_Opts, S0, S0, integer_exponential_notation, _Setting, _Secondary, _PT).
170check_entity(Opts, S0, SN, digit_groups, Setting, _Secondary, PT) :-
171 no(Setting),
172 PT =.. [Type, List0],
173 delete(List0, underscore_char(_), List1),
174 delete(List1, space_char(_), List2),
175 List0 \== List2,
176 PT_Expected =.. [Type, List2],
177 plammar:integer_token(Opts, integer_token(Found, PT), _, []),
178 plammar:integer_token(Opts, integer_token(Expected, PT_Expected), _, []),
179 use_msg(Found, Expected, Msg, 'for ISO conformity'),
180 state_warn(S0, SN, [prop(digit_groups), msg(Msg)]).
181check_entity(_Opts, S0, S0, digit_groups, _Setting, _Secondary, _PT).
185check_entity(_Opts, S0, SN, single_quote_char_in_character_code_constant, Setting, _Secondary, PT) :-
186 no(Setting),
187 PT = character_code_constant(['0', single_quote_char('\''), single_quoted_character(single_quote_char('\''))]),
188 189 Found = '0\'\'',
190 Expected = '0\'\\\'',
191 use_msg(Found, Expected, Msg, 'for ISO conformity'),
192 state_warn(S0, SN, [prop(single_quote_char_in_character_code_constant), msg(Msg)]).
193check_entity(_Opts, S0, S0, single_quote_char_in_character_code_constant, _Setting, _Secondary, _PT).
197check_entity(_Opts, S0, SN, symbolic_chars, Setting, Secondary, PT) :-
198 no(Setting),
199 PT = non_quote_char(control_escape_sequence([backslash_char('\\'),symbolic_control_char(PT_Symbolic_Control_Char)])),
200 option(disallow(Disallow), Secondary, ['c','e','s']),
201 PT_Symbolic_Control_Char =.. [_Type, Char],
202 member(Char, Disallow),
203 state_warn(S0, SN, [prop(symbolic_chars), char(Char)]).
204check_entity(_Opts, S0, S0, symbolic_chars, _Setting, _Secondary, _PT).
208check_entity(_Opts, S0, SN, unicode_character_escape, Setting, _Secondary, PT) :-
209 no(Setting),
210 PT = non_quote_char(unicode_escape_sequence(_)),
211 state_warn(S0, SN, [prop(unicode_character_escape)]).
212check_entity(_Opts, S0, S0, unicode_character_escape, _Setting, _Secondary, _PT).
216check_entity(_Opts, S0, SN, missing_closing_backslash_in_character_escape, Setting, _Secondary, PT) :-
217 no(Setting),
218 PT = non_quote_char(hexadecimal_escape_sequence([backslash_char('\\'), symbolic_hexadecimal_char('x')|Digits])),
219 \+ append(_, [backslash_char('\\')], Digits),
220 state_warn(S0, SN, [prop(missing_closing_backslash_in_character_escape)]).
221check_entity(_Opts, S0, SN, missing_closing_backslash_in_character_escape, Setting, _Secondary, PT) :-
222 no(Setting),
223 PT = non_quote_char(octal_escape_sequence([backslash_char('\\')|Digits])),
224 \+ append(_, [backslash_char('\\')], Digits),
225 state_warn(S0, SN, [prop(missing_closing_backslash_in_character_escape)]).
226check_entity(_Opts, S0, S0, missing_closing_backslash_in_character_escape, _Setting, _Secondary, _PT).
230check_entity(_Opts, S0, S0, Prop, Value, _, _Entity) :-
231 warning('Unknown value "~w" for checked property "~w".', [Value, Prop]),
232 !