Skip to content

Commit e50310f

Browse files
HugoGGuerrierHugoGGuerrier
committed
Factorize matching logic in 'identifier_prefixes' to avoid duplication
Before this commit, we matched on the rule's ode twice: once to know if the node violates the rule, and the other time to get the diagnostic message related to the node's kind. Now we use a function to get from a node, either a diagnostic message when the node violates the rule, or unit if the node is "valid".
1 parent acd297e commit e50310f

File tree

1 file changed

+173
-155
lines changed

1 file changed

+173
-155
lines changed

‎lkql_checker/share/lkql/identifier_prefixes.lkql‎

Lines changed: 173 additions & 155 deletions
Original file line numberDiff line numberDiff line change
@@ -1,13 +1,5 @@
11
import stdlib
22

3-
fun get_derived(t, derived) = {
4-
|" Return the element from derived corresponding to t, if any, or ""
5-
val name = t.p_canonical_type()
6-
.p_canonical_fully_qualified_name();
7-
val res = [n for n in derived if name == n.split(":")[1]].to_list;
8-
if not res then "" else res[res.length]
9-
}
10-
113
fun is_class_access(type_decl) =
124
|" Given a TypeDecl node, return whether the declared type is an access
135
|" to classwide values.
@@ -191,6 +183,8 @@ fun identifier_prefixes(
191183
|" Exc_2 : exception; -- FLAG
192184
|" end Foo;
193185
{
186+
val str_prefix = " does not start with ";
187+
194188
fun check_exclusive(
195189
str,
196190
type_exclusive=true,
@@ -215,167 +209,191 @@ fun identifier_prefixes(
215209
);
216210

217211
fun check_enum(str) =
218-
(enum != "-" and not str.starts_with(enum))
219-
or check_exclusive(str, enum_exclusive=false);
220-
221-
val str_prefix = " does not start with ";
212+
if (
213+
(enum != "-" and not str.starts_with(enum))
214+
or check_exclusive(str, enum_exclusive=false)
215+
)
216+
then str_prefix & "enumeration prefix " & enum
217+
else ();
222218

223-
[{message: n.text &
224-
(match n.parent
225-
| p@(TaskTypeDecl | ProtectedTypeDecl |
226-
SubtypeDecl(p_canonical_type(): TaskTypeDecl | ProtectedTypeDecl))
227-
when p is not SingleTaskTypeDecl and concurrent != "-"
228-
=> str_prefix & "concurrent prefix " & concurrent
229-
| (TypeDecl(f_type_def: TypeAccessDef(f_subtype_indication: *(f_name:
230-
AttributeRef(f_attribute: Identifier(p_name_is("Class"): true))))) |
231-
SubtypeDecl(p_canonical_type(): TypeDecl(f_type_def:
232-
TypeAccessDef(f_subtype_indication: *(f_name:
233-
AttributeRef(f_attribute: Identifier(p_name_is("Class"): true)))))))
234-
when class_access != "-" => str_prefix & "access-to-class prefix " & class_access
235-
| (TypeDecl(f_type_def: AccessToSubpDef) |
236-
SubtypeDecl(p_canonical_type():
237-
TypeDecl(f_type_def: AccessToSubpDef)))
238-
when subprogram_access != "-" =>
239-
str_prefix & "access-to-subprogram prefix " & subprogram_access
240-
| (TypeDecl(f_type_def: AccessDef) |
241-
SubtypeDecl(p_canonical_type(): TypeDecl(f_type_def: AccessDef)))
242-
when access != "-" => str_prefix & "access prefix " & access
219+
@memoized
220+
fun get_derived(t) = {
221+
|" Return the element from derived corresponding to t, if any, or ""
222+
val name = t.p_canonical_type()
223+
.p_canonical_fully_qualified_name();
224+
val res = [n for n in derived if name == n.split(":")[1]].to_list;
225+
if not res then "" else res[res.length]
226+
};
243227

244-
| p@(TypeDecl(f_type_def: DerivedTypeDef) | SubtypeDecl)
245-
when derived != [] and
246-
p.p_canonical_type().p_base_type() is t@BaseTypeDecl
247-
when get_derived(t, derived) != ""
248-
=> {
249-
val t = p.p_canonical_type().p_base_type();
250-
str_prefix & "derived prefix " & get_derived(t, derived)
251-
.split(":")[2]
252-
}
228+
fun check_prefix(name) =
229+
|" Given a DefiningName, check that it is validating all expressed
230+
|" prefix constraints. Returns a string containing the message
231+
|" explaining the constraint violation if the defining name is
232+
|" invalid, unit else.
233+
match name.parent
234+
# Concurrent types
235+
| p@(TaskTypeDecl | ProtectedTypeDecl | TaskBody | ProtectedBody
236+
| SubtypeDecl(p_canonical_type(): TaskTypeDecl | ProtectedTypeDecl))
237+
when p is not SingleTaskTypeDecl
238+
and concurrent != "-"
239+
=>
240+
if (
241+
p.p_previous_part() is (null | IncompleteTypeDecl) and (
242+
not name.f_name.text.starts_with(concurrent)
243+
or check_exclusive(name.f_name.text, concurrent_exclusive=false)
244+
)
245+
)
246+
then str_prefix & "concurrent prefix " & concurrent
247+
else ()
253248

254-
| BaseTypeDecl => str_prefix & "subtype prefix " & type
255-
| EnumLiteralDecl => str_prefix & "enumeration prefix " & enum
256-
| p => match p.parent
257-
| (ObjectDecl | NumberDecl) =>
258-
str_prefix & "constant prefix " & constant
259-
| SubpRenamingDecl => str_prefix & "enumeration prefix " & enum
260-
| ExceptionDecl => str_prefix & "exception prefix " & exception
261-
| * => " does not have an exclusive prefix"),
262-
loc: n}
263-
for n in from unit.root select node@DefiningName when match node.parent
264-
# Concurrent types
265-
| p@(TaskTypeDecl | ProtectedTypeDecl | TaskBody | ProtectedBody |
266-
SubtypeDecl(p_canonical_type(): TaskTypeDecl | ProtectedTypeDecl))
267-
when p is not SingleTaskTypeDecl and concurrent != "-"
268-
=>
269-
p.p_previous_part() is (null | IncompleteTypeDecl) and
270-
(
271-
if node.f_name.text.starts_with(concurrent)
272-
then check_exclusive(node.f_name.text, concurrent_exclusive=false)
273-
)
249+
# 'Class access
250+
| (
251+
p@TypeDecl when is_class_access(p)
252+
| p@SubtypeDecl(
253+
p_canonical_type(): td@TypeDecl when is_class_access(td)
254+
)
255+
) when class_access != "-"
256+
=>
257+
if (
258+
p.p_previous_part() is (null | IncompleteTypeDecl) and (
259+
not name.f_name.text.starts_with(class_access)
260+
or check_exclusive(name.f_name.text, class_access_exclusive=false)
261+
)
262+
)
263+
then str_prefix & "access-to-class prefix " & class_access
264+
else ()
274265

275-
# 'Class access
276-
| (
277-
p@TypeDecl when is_class_access(p) |
278-
p@SubtypeDecl(
279-
p_canonical_type(): td@TypeDecl when is_class_access(td)
280-
)
281-
) when class_access != "-"
282-
=>
283-
p?.p_previous_part() is (null | IncompleteTypeDecl)
284-
and (
285-
if node.f_name.text.starts_with(class_access)
286-
then check_exclusive(node.f_name.text, class_access_exclusive=false)
287-
)
266+
# Subprogram access
267+
| (
268+
p@TypeDecl(f_type_def: AccessToSubpDef)
269+
| p@SubtypeDecl(
270+
p_canonical_type(): TypeDecl(f_type_def: AccessToSubpDef)
271+
)
272+
) when subprogram_access != "-"
273+
=>
274+
if (
275+
p.p_previous_part() is (null | IncompleteTypeDecl) and (
276+
not name.f_name.text.starts_with(subprogram_access)
277+
or check_exclusive(name.f_name.text, subprogram_access_exclusive=false)
278+
)
279+
)
280+
then str_prefix & "access-to-subprogram prefix " & subprogram_access
281+
else ()
288282

289-
# Subprogram access
290-
| (
291-
p@TypeDecl(f_type_def: AccessToSubpDef)
292-
| p@SubtypeDecl(
293-
p_canonical_type(): TypeDecl(f_type_def: AccessToSubpDef)
294-
)
295-
) when subprogram_access != "-"
296-
=>
297-
p?.p_previous_part() is (null | IncompleteTypeDecl)
298-
and (
299-
if node.f_name.text.starts_with(subprogram_access)
300-
then check_exclusive(node.f_name.text, subprogram_access_exclusive=false)
301-
)
283+
# Other access types
284+
| (
285+
p@TypeDecl(f_type_def: AccessDef)
286+
| p@SubtypeDecl(
287+
p_canonical_type(): TypeDecl(f_type_def: AccessDef)
288+
)
289+
) when access != "-"
290+
=>
291+
if (
292+
p.p_previous_part() is (null | IncompleteTypeDecl) and (
293+
not name.f_name.text.starts_with(access)
294+
or check_exclusive(
295+
name.f_name.text,
296+
access_exclusive=false,
297+
# If both an Access prefix and a Type prefix are
298+
# set and the type prefix is a prefix of the access
299+
# prefix, we don't want to flag this access because
300+
# it broke the exclusivity of the type prefix.
301+
type_exclusive=false
302+
)
303+
)
304+
)
305+
then str_prefix & "access prefix " & access
306+
else ()
302307

303-
# Other access types
304-
| (
305-
p@TypeDecl(f_type_def: AccessDef)
306-
| p@SubtypeDecl(p_canonical_type(): TypeDecl(f_type_def: AccessDef))
307-
) when access != "-"
308-
=>
309-
p?.p_previous_part() is (null | IncompleteTypeDecl)
310-
and (
311-
if node.f_name.text.starts_with(access)
312-
then check_exclusive(
313-
node.f_name.text,
314-
access_exclusive=false,
315-
# If both an Access prefix and a Type prefix are
316-
# set and the type prefix is a prefix of the access
317-
# prefix, we don't want to flag this access because
318-
# it broke the exclusivity of the type prefix.
319-
type_exclusive=false
308+
# (Sub)Types derived from `derived`
309+
| p@(TypeDecl(f_type_def: DerivedTypeDef) | SubtypeDecl)
310+
when derived != []
311+
and p.p_canonical_type().p_base_type() is t@BaseTypeDecl
312+
when get_derived(t) != ""
313+
=> {
314+
val derived_res = get_derived(p.p_canonical_type().p_base_type());
315+
if (
316+
p.p_previous_part() is (null | IncompleteTypeDecl) and (
317+
derived_res != ""
318+
and not name.f_name.text.starts_with(derived_res.split(":")[2])
319+
)
320320
)
321-
)
321+
then str_prefix & "derived prefix " & derived_res.split(":")[2]
322+
else ()
323+
}
322324

323-
# (Sub)Types derived from `derived`
324-
| p@(TypeDecl(f_type_def: DerivedTypeDef) | SubtypeDecl)
325-
when derived != []
326-
and p.p_canonical_type().p_base_type() is t@BaseTypeDecl
327-
when get_derived(t, derived) != ""
328-
=> {
329-
val t = p.p_canonical_type().p_base_type();
330-
p.p_previous_part() is (null | IncompleteTypeDecl)
331-
and not node.f_name.text.starts_with(
332-
get_derived(t, derived).split(":")[2]
333-
)
334-
}
325+
# Exclude IncompleteTypeDecl
326+
| IncompleteTypeDecl => ()
335327

336-
# Exclude IncompleteTypeDecl
337-
| IncompleteTypeDecl => false
328+
# Other types and subtypes
329+
| p@BaseTypeDecl
330+
when p is not SingleTaskTypeDecl
331+
=>
332+
if (
333+
p.p_previous_part() is (null | IncompleteTypeDecl) and (
334+
(type != "-" and not name.f_name.text.starts_with(type))
335+
or check_exclusive(name.f_name.text, type_exclusive=false)
336+
)
337+
)
338+
then str_prefix & "subtype prefix " & type
339+
else ()
338340

339-
# Other types and subtypes
340-
| p@BaseTypeDecl when p is not SingleTaskTypeDecl =>
341-
p.p_previous_part() is (null | IncompleteTypeDecl)
342-
and (
343-
(type != "-" and not node.f_name.text.starts_with(type))
344-
or check_exclusive(node.f_name.text, type_exclusive=false)
345-
)
341+
# Enums
342+
| EnumLiteralDecl => check_enum(name.f_name.text)
346343

347-
# Enums
348-
| EnumLiteralDecl => check_enum(node.f_name.text)
344+
# Look one level up for remaining cases
345+
| p => match p.parent
346+
# Constants
347+
| (
348+
ObjectDecl(p_is_constant_object(): true)
349+
| NumberDecl
350+
) =>
351+
if (
352+
name.p_previous_part() is null and (
353+
(constant != "-" and not name.f_name.text.starts_with(constant))
354+
or check_exclusive(name.f_name.text, constant_exclusive=false)
355+
)
356+
)
357+
then str_prefix & "constant prefix " & constant
358+
else ()
349359

350-
# Look one level up for remaining cases
351-
| p => match p.parent
352-
# Constants
353-
| (
354-
ObjectDecl(p_is_constant_object(): true) when not node.p_previous_part()
355-
| NumberDecl
356-
) =>
357-
(constant != "-" and not node.f_name.text.starts_with(constant))
358-
or check_exclusive(node.f_name.text, constant_exclusive=false)
359360

361+
# Function renaming an enum literal
362+
| r@SubpRenamingDecl
363+
when r.f_renames?.f_renamed_object?.p_referenced_decl?() is EnumLiteralDecl
364+
=>
365+
check_enum(name.f_name.text)
366+
367+
# Exceptions
368+
| ExceptionDecl =>
369+
if (
370+
(exception != "-" and not name.f_name.text.starts_with(exception))
371+
or check_exclusive(name.f_name.text, exception_exclusive=false)
372+
)
373+
then str_prefix & "exception prefix " & exception
374+
else ()
360375

361-
# Function renaming an enum literal
362-
| r@SubpRenamingDecl
363-
when r.f_renames?.f_renamed_object?.p_referenced_decl() is EnumLiteralDecl
364-
=> check_enum(node.f_name.text)
376+
# Avoid checking declaration completions
377+
| p@(BodyNode | SubpRenamingDecl | ObjectDecl) => {
378+
val n = if p is ObjectDecl then name else p;
379+
if n.p_previous_part() is null and check_exclusive(name.f_name.text)
380+
then " does not have an exclusive prefix"
381+
else ()
382+
}
365383

366-
# Exceptions
367-
| ExceptionDecl =>
368-
(exception != "-" and not node.f_name.text.starts_with(exception))
369-
or check_exclusive(node.f_name.text, exception_exclusive=false)
384+
# All other cases, check the exclusivity
385+
| * =>
386+
if check_exclusive(name.f_name.text)
387+
then " does not have an exclusive prefix"
388+
else ();
370389

371-
# Check all other defining names for exclusion except for completions
372-
# and renaming-as-body
373-
| p2 =>
374-
(
375-
if p2 is (BodyNode | SubpRenamingDecl)
376-
then not p2.p_previous_part()
377-
) and (
378-
if p2 is ObjectDecl
379-
then not node.p_previous_part()
380-
) and check_exclusive(node.f_name.text)]
390+
# Iterate over all defining names and check prefixes for each
391+
[
392+
{message: s[1].text & s[2], loc: s[1]}
393+
for s in [
394+
(n, check_prefix(n))
395+
for n in from unit.root select DefiningName
396+
]
397+
if s[2] != ()
398+
]
381399
}

0 commit comments

Comments
 (0)