Skip to content

Commit 0a45786

Browse files
Leonidas-from-XIVLeonidas-from-XIV
committed
Interpret let_bound_idents_with_modes_sorts_and_checks as a table
1 parent 94996cb commit 0a45786

1 file changed

Lines changed: 27 additions & 25 deletions

File tree

‎src/loader/cmt.ml‎

Lines changed: 27 additions & 25 deletions
Original file line numberDiff line numberDiff line change
@@ -36,10 +36,7 @@ let cmt_builddir : string ref = ref ""
3636
let read_core_type env ctyp =
3737
Cmi.read_type_expr env ctyp.ctyp_type
3838

39-
let zero_attr_of_ident (_ident, _, zero_alloc) =
40-
Doc_attr.lang_value_attr_of_zero_alloc zero_alloc
41-
42-
let rec read_pattern env parent doc vb pat =
39+
let rec read_pattern env parent doc id_attrs pat =
4340
let source_loc = None in
4441
let open Signature in
4542
match pat.pat_desc with
@@ -52,14 +49,11 @@ let rec read_pattern env parent doc vb pat =
5249
| Tpat_var(id, _, _uid) ->
5350
#endif
5451
let open Value in
52+
let ext_attr = id_attrs id in
5553
let id = Env.find_value_identifier env.ident_env id in
5654
Cmi.mark_type_expr pat.pat_type;
5755
let type_ = Cmi.read_type_expr env pat.pat_type in
5856
let value = Abstract in
59-
let ext_attr = [vb]
60-
|> let_bound_idents_with_modes_sorts_and_checks
61-
|> List.filter_map zero_attr_of_ident
62-
in
6357
[Value {id; source_loc; doc; type_; value; ext_attr}]
6458
#if OCAML_VERSION < (5,2, 0)
6559
| Tpat_alias(pat, id, _) ->
@@ -71,56 +65,53 @@ let rec read_pattern env parent doc vb pat =
7165
| Tpat_alias(pat, id,_,_,_) ->
7266
#endif
7367
let open Value in
68+
let ext_attr = id_attrs id in
7469
let id = Env.find_value_identifier env.ident_env id in
7570
Cmi.mark_type_expr pat.pat_type;
7671
let type_ = Cmi.read_type_expr env pat.pat_type in
7772
let value = Abstract in
78-
let ext_attr = [vb]
79-
|> let_bound_idents_with_modes_sorts_and_checks
80-
|> List.filter_map zero_attr_of_ident
81-
in
82-
Value {id; source_loc; doc; type_; value; ext_attr} :: read_pattern env parent doc vb pat
73+
Value {id; source_loc; doc; type_; value; ext_attr} :: read_pattern env parent doc id_attrs pat
8374
| Tpat_constant _ -> []
8475
| Tpat_tuple pats ->
8576
#if OCAML_VERSION >= (5, 4, 0) || defined OXCAML
8677
let pats = List.map snd pats (* remove labels *) in
8778
#endif
88-
List.concat (List.map (read_pattern env parent doc vb) pats)
79+
List.concat (List.map (read_pattern env parent doc id_attrs) pats)
8980
#if defined OXCAML
9081
| Tpat_unboxed_tuple pats ->
91-
List.concat (List.map (fun (_, p, _) -> read_pattern env parent doc vb p) pats)
82+
List.concat (List.map (fun (_, p, _) -> read_pattern env parent doc id_attrs p) pats)
9283
#endif
9384
#if OCAML_VERSION < (4, 13, 0)
9485
| Tpat_construct(_, _, pats) ->
9586
#else
9687
| Tpat_construct(_,_,pats,_) ->
9788
#endif
98-
List.concat (List.map (read_pattern env parent doc vb) pats)
89+
List.concat (List.map (read_pattern env parent doc id_attrs) pats)
9990
| Tpat_variant(_, None, _) -> []
10091
| Tpat_variant(_, Some pat, _) ->
101-
read_pattern env parent doc vb pat
92+
read_pattern env parent doc id_attrs pat
10293
| Tpat_record(pats, _) ->
10394
List.concat
10495
(List.map
105-
(fun (_, _, pat) -> read_pattern env parent doc vb pat)
96+
(fun (_, _, pat) -> read_pattern env parent doc id_attrs pat)
10697
pats)
10798
#if defined OXCAML
10899
| Tpat_record_unboxed_product(pats, _) ->
109100
List.concat
110101
(List.map
111-
(fun (_, _, pat) -> read_pattern env parent doc vb pat)
102+
(fun (_, _, pat) -> read_pattern env parent doc id_attrs pat)
112103
pats)
113104
| Tpat_array (_, _, pats) ->
114105
#elif OCAML_VERSION < (5, 4, 0)
115106
| Tpat_array pats ->
116107
#else
117108
| Tpat_array (_, pats) ->
118109
#endif
119-
List.concat (List.map (read_pattern env parent doc vb) pats)
110+
List.concat (List.map (read_pattern env parent doc id_attrs) pats)
120111
| Tpat_or(pat, _, _) ->
121-
read_pattern env parent doc vb pat
112+
read_pattern env parent doc id_attrs pat
122113
| Tpat_lazy pat ->
123-
read_pattern env parent doc vb pat
114+
read_pattern env parent doc id_attrs pat
124115
#if OCAML_VERSION >= (4,8,0) && OCAML_VERSION < (4,11,0)
125116
| Tpat_exception pat ->
126117
read_pattern env parent doc pat
@@ -130,21 +121,32 @@ let rec read_pattern env parent doc vb pat =
130121
| Tpat_unboxed_bool _ -> []
131122
#endif
132123

133-
let read_value_binding env parent vb =
124+
let read_value_binding env parent id_attrs vb =
134125
let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in
135126
let doc = Doc_attr.attached_no_tag ~warnings_tag:env.warnings_tag container vb.vb_attributes in
136-
read_pattern env parent doc vb vb.vb_pat
127+
read_pattern env parent doc id_attrs vb.vb_pat
137128

138129
let read_value_bindings env parent vbs =
139130
let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in
131+
let id_attrs =
132+
vbs |> let_bound_idents_with_modes_sorts_and_checks |> List.fold_left (fun tbl (ident, _, zero_alloc) ->
133+
match Doc_attr.lang_value_attr_of_zero_alloc zero_alloc with
134+
| None -> tbl
135+
| Some attr -> Ident.add ident [attr] tbl) Ident.empty
136+
in
137+
let lookup_attr_by_id id =
138+
match Ident.find_same id id_attrs with
139+
| attr -> attr
140+
| exception Not_found -> []
141+
in
140142
let items =
141143
List.fold_left
142144
(fun acc vb ->
143145
let open Signature in
144146
let comments =
145147
Doc_attr.standalone_multiple container ~warnings_tag:env.warnings_tag vb.vb_attributes in
146148
let comments = List.map (fun com -> Comment com) comments in
147-
let vb = read_value_binding env parent vb in
149+
let vb = read_value_binding env parent lookup_attr_by_id vb in
148150
List.rev_append vb (List.rev_append comments acc))
149151
[] vbs
150152
in

0 commit comments

Comments
 (0)