The unpac monorepo manager self-hosting as a monorepo using unpac
Add attr tracking mechanism, but don't whitelist any attrs yet
+192
-28
+8
.depend
+8
.depend
···
290
290
utils/misc.cmi \
291
291
parsing/longident.cmi \
292
292
parsing/location.cmi \
293
+
utils/clflags.cmi \
293
294
parsing/asttypes.cmi \
295
+
parsing/ast_iterator.cmi \
296
+
parsing/ast_helper.cmi \
294
297
parsing/builtin_attributes.cmi
295
298
parsing/builtin_attributes.cmx : \
296
299
utils/warnings.cmx \
···
298
301
utils/misc.cmx \
299
302
parsing/longident.cmx \
300
303
parsing/location.cmx \
304
+
utils/clflags.cmx \
301
305
parsing/asttypes.cmi \
306
+
parsing/ast_iterator.cmx \
307
+
parsing/ast_helper.cmx \
302
308
parsing/builtin_attributes.cmi
303
309
parsing/builtin_attributes.cmi : \
304
310
parsing/parsetree.cmi \
···
413
419
parsing/docstrings.cmi \
414
420
utils/clflags.cmi \
415
421
parsing/camlinternalMenhirLib.cmi \
422
+
parsing/builtin_attributes.cmi \
416
423
parsing/asttypes.cmi \
417
424
parsing/ast_helper.cmi \
418
425
parsing/parser.cmi
···
424
431
parsing/docstrings.cmx \
425
432
utils/clflags.cmx \
426
433
parsing/camlinternalMenhirLib.cmx \
434
+
parsing/builtin_attributes.cmx \
427
435
parsing/asttypes.cmi \
428
436
parsing/ast_helper.cmx \
429
437
parsing/parser.cmi
+25
-8
.depend.menhir
+25
-8
.depend.menhir
···
1
-
parsing/parser.cmo : parsing/syntaxerr.cmi parsing/parsetree.cmi \
2
-
parsing/longident.cmi parsing/location.cmi parsing/docstrings.cmi \
3
-
utils/clflags.cmi parsing/asttypes.cmi parsing/ast_helper.cmi \
1
+
parsing/parser.cmo : \
2
+
parsing/syntaxerr.cmi \
3
+
parsing/parsetree.cmi \
4
+
parsing/longident.cmi \
5
+
parsing/location.cmi \
6
+
parsing/docstrings.cmi \
7
+
utils/clflags.cmi \
8
+
parsing/builtin_attributes.cmi \
9
+
parsing/asttypes.cmi \
10
+
parsing/ast_helper.cmi \
4
11
parsing/parser.cmi
5
-
parsing/parser.cmx : parsing/syntaxerr.cmx parsing/parsetree.cmi \
6
-
parsing/longident.cmx parsing/location.cmx parsing/docstrings.cmx \
7
-
utils/clflags.cmx parsing/asttypes.cmi parsing/ast_helper.cmx \
12
+
parsing/parser.cmx : \
13
+
parsing/syntaxerr.cmx \
14
+
parsing/parsetree.cmi \
15
+
parsing/longident.cmx \
16
+
parsing/location.cmx \
17
+
parsing/docstrings.cmx \
18
+
utils/clflags.cmx \
19
+
parsing/builtin_attributes.cmx \
20
+
parsing/asttypes.cmi \
21
+
parsing/ast_helper.cmx \
8
22
parsing/parser.cmi
9
-
parsing/parser.cmi : parsing/parsetree.cmi parsing/location.cmi \
23
+
parsing/parser.cmi : \
24
+
parsing/parsetree.cmi \
25
+
parsing/longident.cmi \
26
+
parsing/location.cmi \
10
27
parsing/docstrings.cmi
11
-
parsing/parser.ml parsing/parser.mli: parsing/ast_helper.cmi parsing/asttypes.cmi utils/clflags.cmi parsing/docstrings.cmi parsing/location.cmi parsing/longident.cmi parsing/parsetree.cmi parsing/syntaxerr.cmi
28
+
parsing/parser.ml parsing/parser.mli: parsing/ast_helper.cmi parsing/asttypes.cmi parsing/builtin_attributes.cmi utils/clflags.cmi parsing/docstrings.cmi parsing/location.cmi parsing/longident.cmi parsing/parsetree.cmi parsing/syntaxerr.cmi
+4
-2
Makefile
+4
-2
Makefile
···
94
94
docstrings.mli docstrings.ml \
95
95
syntaxerr.mli syntaxerr.ml \
96
96
ast_helper.mli ast_helper.ml \
97
+
ast_iterator.mli ast_iterator.ml \
98
+
builtin_attributes.mli builtin_attributes.ml \
97
99
camlinternalMenhirLib.mli camlinternalMenhirLib.ml \
98
100
parser.mly \
99
101
lexer.mll \
···
101
103
parse.mli parse.ml \
102
104
printast.mli printast.ml \
103
105
ast_mapper.mli ast_mapper.ml \
104
-
ast_iterator.mli ast_iterator.ml \
105
106
attr_helper.mli attr_helper.ml \
106
-
builtin_attributes.mli builtin_attributes.ml \
107
107
ast_invariants.mli ast_invariants.ml \
108
108
depend.mli depend.ml)
109
109
···
2106
2106
docstrings.mli docstrings.ml \
2107
2107
syntaxerr.mli syntaxerr.ml \
2108
2108
ast_helper.mli ast_helper.ml \
2109
+
ast_iterator.mli ast_iterator.ml \
2110
+
builtin_attributes.mli builtin_attributes.ml \
2109
2111
camlinternalMenhirLib.mli camlinternalMenhirLib.ml \
2110
2112
parser.mli parser.ml \
2111
2113
lexer.mli lexer.ml \
+2
driver/compile_common.ml
+2
driver/compile_common.ml
···
60
60
sg);
61
61
ignore (Includemod.signatures info.env ~mark:Mark_both sg sg);
62
62
Typecore.force_delayed_checks ();
63
+
Builtin_attributes.warn_unused ();
63
64
Warnings.check_fatal ();
64
65
tsg
65
66
···
117
118
backend info typed
118
119
end;
119
120
end;
121
+
Builtin_attributes.warn_unused ();
120
122
Warnings.check_fatal ();
121
123
)
+2
-2
dune
+2
-2
dune
···
49
49
50
50
;; PARSING
51
51
location longident docstrings syntaxerr ast_helper camlinternalMenhirLib
52
-
parser lexer parse printast pprintast ast_mapper ast_iterator attr_helper
53
-
builtin_attributes ast_invariants depend
52
+
ast_iterator builtin_attributes parser lexer parse printast pprintast
53
+
ast_mapper attr_helper ast_invariants depend
54
54
; manual update: mli only files
55
55
asttypes parsetree
56
56
+2
-1
otherlibs/dynlink/Makefile
+2
-1
otherlibs/dynlink/Makefile
···
93
93
parsing/docstrings.ml \
94
94
parsing/syntaxerr.ml \
95
95
parsing/ast_helper.ml \
96
+
parsing/ast_iterator.ml \
97
+
parsing/builtin_attributes.ml \
96
98
parsing/ast_mapper.ml \
97
99
parsing/camlinternalMenhirLib.ml \
98
100
parsing/parser.ml \
99
101
parsing/lexer.ml \
100
102
parsing/attr_helper.ml \
101
-
parsing/builtin_attributes.ml \
102
103
typing/ident.ml \
103
104
typing/path.ml \
104
105
typing/primitive.ml \
+9
parsing/ast_invariants.ml
+9
parsing/ast_invariants.ml
···
180
180
"In object types, attaching attributes to inherited \
181
181
subtypes is not allowed."
182
182
in
183
+
let attribute self attr =
184
+
(* The change to `self` here avoids registering attributes within attributes
185
+
for the purposes of warning 53, while keeping all the other invariant
186
+
checks for attribute payloads. See comment on [attr_tracking_time] in
187
+
[builtin_attributes.mli]. *)
188
+
super.attribute { self with attribute = super.attribute } attr;
189
+
Builtin_attributes.(register_attr Invariant_check attr.attr_name)
190
+
in
183
191
{ super with
184
192
type_declaration
185
193
; typ
···
195
203
; signature_item
196
204
; row_field
197
205
; object_field
206
+
; attribute
198
207
}
199
208
200
209
let structure st = iterator.structure iterator st
+76
parsing/builtin_attributes.ml
+76
parsing/builtin_attributes.ml
···
15
15
16
16
open Asttypes
17
17
open Parsetree
18
+
open Ast_helper
19
+
20
+
21
+
module Attribute_table = Hashtbl.Make (struct
22
+
type t = string with_loc
23
+
24
+
let hash : t -> int = Hashtbl.hash
25
+
let equal : t -> t -> bool = (=)
26
+
end)
27
+
let unused_attrs = Attribute_table.create 128
28
+
let mark_used t = Attribute_table.remove unused_attrs t
29
+
30
+
(* [attr_order] is used to issue unused attribute warnings in the order the
31
+
attributes occur in the file rather than the random order of the hash table
32
+
*)
33
+
let attr_order a1 a2 =
34
+
match String.compare a1.loc.loc_start.pos_fname a2.loc.loc_start.pos_fname
35
+
with
36
+
| 0 -> Int.compare a1.loc.loc_start.pos_cnum a2.loc.loc_start.pos_cnum
37
+
| n -> n
38
+
39
+
let warn_unused () =
40
+
let keys = List.of_seq (Attribute_table.to_seq_keys unused_attrs) in
41
+
let keys = List.sort attr_order keys in
42
+
List.iter (fun sloc ->
43
+
Location.prerr_warning sloc.loc (Warnings.Misplaced_attribute sloc.txt))
44
+
keys
45
+
46
+
(* These are the attributes that are tracked in the builtin_attrs table for
47
+
misplaced attribute warnings. *)
48
+
let builtin_attrs =
49
+
[ (* "alert"; "ocaml.alert" *)
50
+
(* ; "boxed"; "ocaml.boxed" *)
51
+
(* ; "deprecated"; "ocaml.deprecated" *)
52
+
(* ; "deprecated_mutable"; "ocaml.deprecated_mutable" *)
53
+
(* ; "explicit_arity"; "ocaml.explicit_arity" *)
54
+
(* ; "immediate"; "ocaml.immediate" *)
55
+
(* ; "immediate64"; "ocaml.immediate64" *)
56
+
(* ; "inline"; "ocaml.inline" *)
57
+
(* ; "inlined"; "ocaml.inlined" *)
58
+
(* ; "noalloc"; "ocaml.noalloc" *)
59
+
(* ; "ppwarning"; "ocaml.ppwarning" *)
60
+
(* ; "tailcall"; "ocaml.tailcall" *)
61
+
(* ; "unboxed"; "ocaml.unboxed" *)
62
+
(* ; "untagged"; "ocaml.untagged" *)
63
+
(* ; "unrolled"; "ocaml.unrolled" *)
64
+
(* ; "warnerror"; "ocaml.warnerror" *)
65
+
(* ; "warning"; "ocaml.warning" *)
66
+
(* ; "warn_on_literal_pattern"; "ocaml.warn_on_literal_pattern" *)
67
+
]
68
+
69
+
let builtin_attrs =
70
+
let tbl = Hashtbl.create 128 in
71
+
List.iter (fun attr -> Hashtbl.add tbl attr ()) builtin_attrs;
72
+
tbl
73
+
74
+
let is_builtin_attr s = Hashtbl.mem builtin_attrs s
75
+
76
+
type attr_tracking_time = Parser | Invariant_check
77
+
78
+
let register_attr attr_tracking_time name =
79
+
match attr_tracking_time with
80
+
| Parser when !Clflags.all_ppx <> [] -> ()
81
+
| Parser | Invariant_check ->
82
+
if is_builtin_attr name.txt then
83
+
Attribute_table.replace unused_attrs name ()
18
84
19
85
let string_of_cst = function
20
86
| Pconst_string(s, _, _) -> Some s
···
66
132
end
67
133
| ({txt; loc}, _) ->
68
134
Location.errorf ~loc "Uninterpreted extension '%s'." txt
135
+
136
+
let mark_payload_attrs_used payload =
137
+
let iter =
138
+
{ Ast_iterator.default_iterator
139
+
with attribute = fun self a ->
140
+
mark_used a.attr_name;
141
+
Ast_iterator.default_iterator.attribute self a
142
+
}
143
+
in
144
+
iter.payload iter payload
69
145
70
146
let kind_and_message = function
71
147
| PStr[
+48
-9
parsing/builtin_attributes.mli
+48
-9
parsing/builtin_attributes.mli
···
13
13
(* *)
14
14
(**************************************************************************)
15
15
16
-
(** Support for some of the builtin attributes
16
+
(** Support for the builtin attributes:
17
17
18
+
- ocaml.alert
19
+
- ocaml.boxed
18
20
- ocaml.deprecated
19
-
- ocaml.alert
20
-
- ocaml.error
21
+
- ocaml.deprecated_mutable
22
+
- ocaml.explicit_arity
23
+
- ocaml.immediate
24
+
- ocaml.immediate64
25
+
- ocaml.inline
26
+
- ocaml.inlined
27
+
- ocaml.noalloc
21
28
- ocaml.ppwarning
22
-
- ocaml.warning
29
+
- ocaml.tailcall
30
+
- ocaml.unboxed
31
+
- ocaml.untagged
32
+
- ocaml.unrolled
23
33
- ocaml.warnerror
24
-
- ocaml.explicit_arity (for camlp4/camlp5)
34
+
- ocaml.warning
25
35
- ocaml.warn_on_literal_pattern
26
-
- ocaml.deprecated_mutable
27
-
- ocaml.immediate
28
-
- ocaml.immediate64
29
-
- ocaml.boxed / ocaml.unboxed
30
36
31
37
{b Warning:} this module is unstable and part of
32
38
{{!Compiler_libs}compiler-libs}.
33
39
34
40
*)
41
+
42
+
43
+
(** [register_attr] must be called on the locations of all attributes that
44
+
should be tracked for the purpose of misplaced attribute warnings. In
45
+
particular, it should be called on all attributes that are present in the
46
+
source program except those that are contained in the payload of another
47
+
attribute (because these may be left behind by a ppx and intentionally
48
+
ignored by the compiler).
49
+
50
+
The [attr_tracking_time] argument indicates when the attr is being added for
51
+
tracking - either when it is created in the parser or when we see it while
52
+
running the check in the [Ast_invariants] module. This ensures that we
53
+
track only attributes from the final version of the parse tree: we skip
54
+
adding attributes at parse time if we can see that a ppx will be run later,
55
+
because the [Ast_invariants] check is always run on the result of a ppx.
56
+
57
+
Note that the [Ast_invariants] check is also run on parse trees created from
58
+
marshalled ast files if no ppx is being used, ensuring we don't miss
59
+
attributes in that case.
60
+
*)
61
+
type attr_tracking_time = Parser | Invariant_check
62
+
val register_attr : attr_tracking_time -> string Location.loc -> unit
63
+
64
+
(** Marks the attributes hiding in the payload of another attribute used, for
65
+
the purposes of misplaced attribute warnings (see comment on
66
+
[attr_tracking_time] above). In the parser, it's simplest to add these to
67
+
the table and remove them later, rather than threading through state
68
+
tracking whether we're in an attribute payload. *)
69
+
val mark_payload_attrs_used : Parsetree.payload -> unit
70
+
71
+
(** Issue misplaced attribute warnings for all attributes created with
72
+
[mk_internal] but not yet marked used. *)
73
+
val warn_unused : unit -> unit
35
74
36
75
val check_alerts: Location.t -> Parsetree.attributes -> string -> unit
37
76
val check_alerts_inclusion:
+16
-6
parsing/parser.mly
+16
-6
parsing/parser.mly
···
167
167
| _ ->
168
168
Pexp_apply(mkoperator ~loc:oploc ("~" ^ name), [Nolabel, arg])
169
169
170
+
let mk_attr ~loc name payload =
171
+
Builtin_attributes.(register_attr Parser name);
172
+
Attr.mk ~loc name payload
173
+
170
174
(* TODO define an abstraction boundary between locations-as-pairs
171
175
and locations-as-Location.t; it should be clear when we move from
172
176
one world to the other *)
···
4037
4041
) { $1 }
4038
4042
;
4039
4043
attribute:
4040
-
LBRACKETAT attr_id payload RBRACKET
4041
-
{ Attr.mk ~loc:(make_loc $sloc) $2 $3 }
4044
+
LBRACKETAT attr_id attr_payload RBRACKET
4045
+
{ mk_attr ~loc:(make_loc $sloc) $2 $3 }
4042
4046
;
4043
4047
post_item_attribute:
4044
-
LBRACKETATAT attr_id payload RBRACKET
4045
-
{ Attr.mk ~loc:(make_loc $sloc) $2 $3 }
4048
+
LBRACKETATAT attr_id attr_payload RBRACKET
4049
+
{ mk_attr ~loc:(make_loc $sloc) $2 $3 }
4046
4050
;
4047
4051
floating_attribute:
4048
-
LBRACKETATATAT attr_id payload RBRACKET
4052
+
LBRACKETATATAT attr_id attr_payload RBRACKET
4049
4053
{ mark_symbol_docs $sloc;
4050
-
Attr.mk ~loc:(make_loc $sloc) $2 $3 }
4054
+
mk_attr ~loc:(make_loc $sloc) $2 $3 }
4051
4055
;
4052
4056
%inline post_item_attributes:
4053
4057
post_item_attribute*
···
4086
4090
| COLON core_type { PTyp $2 }
4087
4091
| QUESTION pattern { PPat ($2, None) }
4088
4092
| QUESTION pattern WHEN seq_expr { PPat ($2, Some $4) }
4093
+
;
4094
+
attr_payload:
4095
+
payload
4096
+
{ Builtin_attributes.mark_payload_attrs_used $1;
4097
+
$1
4098
+
}
4089
4099
;
4090
4100
%%