Skip to content

Commit d759cfd

Browse files
voodoosvoodoos
committed
Shapes: Store cstrs and labels in struct shapes
This requires adding a new kinds for labels and constructors. All nested inline records cases are taken into account: Inline record in types, extensible types and exceptions.
1 parent 9a0f61c commit d759cfd

19 files changed

Lines changed: 381 additions & 164 deletions

‎.depend‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1506,6 +1506,7 @@ typing/typedecl.cmo : \
15061506
typing/typedecl_immediacy.cmi \
15071507
typing/type_immediacy.cmi \
15081508
typing/subst.cmi \
1509+
typing/shape.cmi \
15091510
typing/printtyp.cmi \
15101511
typing/primitive.cmi \
15111512
typing/predef.cmi \
@@ -1543,6 +1544,7 @@ typing/typedecl.cmx : \
15431544
typing/typedecl_immediacy.cmx \
15441545
typing/type_immediacy.cmx \
15451546
typing/subst.cmx \
1547+
typing/shape.cmx \
15461548
typing/printtyp.cmx \
15471549
typing/primitive.cmx \
15481550
typing/predef.cmx \
@@ -1574,6 +1576,7 @@ typing/typedecl.cmi : \
15741576
typing/typedecl_variance.cmi \
15751577
typing/typedecl_separability.cmi \
15761578
typing/typedecl_immediacy.cmi \
1579+
typing/shape.cmi \
15771580
typing/path.cmi \
15781581
parsing/parsetree.cmi \
15791582
parsing/longident.cmi \

‎testsuite/tests/shapes/aliases.ml‎

Lines changed: 7 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -8,14 +8,14 @@ module B = A
88
[%%expect{|
99
{
1010
"A"[module] -> {<.1>
11-
"t"[type] -> <.0>;
11+
"t"[type] -> {<.0>};
1212
};
1313
}
1414
module A : sig type t end
1515
{
1616
"B"[module] -> Alias(<.2>
1717
{<.1>
18-
"t"[type] -> <.0>;
18+
"t"[type] -> {<.0>};
1919
});
2020
}
2121
module B = A
@@ -25,7 +25,7 @@ type u = B.t
2525

2626
[%%expect{|
2727
{
28-
"u"[type] -> <.3>;
28+
"u"[type] -> {<.3>};
2929
}
3030
type u = B.t
3131
|}]
@@ -48,7 +48,7 @@ module C = F'(A)
4848
[%%expect{|
4949
{
5050
"C"[module] -> {<.8>
51-
"t"[type] -> <.0>;
51+
"t"[type] -> {<.0>};
5252
};
5353
}
5454
module C : sig type t = A.t end
@@ -61,7 +61,7 @@ module C = F(B)
6161
{
6262
"C"[module] -> Alias(<.9>
6363
{<.1>
64-
"t"[type] -> <.0>;
64+
"t"[type] -> {<.0>};
6565
});
6666
}
6767
module C : sig type t = B.t end
@@ -74,7 +74,7 @@ module D = C
7474
"D"[module] -> Alias(<.10>
7575
Alias(<.9>
7676
{<.1>
77-
"t"[type] -> <.0>;
77+
"t"[type] -> {<.0>};
7878
}));
7979
}
8080
module D = C
@@ -94,7 +94,7 @@ module E = G(B)
9494
[%%expect{|
9595
{
9696
"E"[module] -> {<.14>
97-
"t"[type] -> <.0>;
97+
"t"[type] -> {<.0>};
9898
};
9999
}
100100
module E : sig type t = B.t end

‎testsuite/tests/shapes/functors.ml‎

Lines changed: 44 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -46,7 +46,7 @@ end
4646
{
4747
"Fredef"[module] ->
4848
Abs<.10>(X/293, {
49-
"t"[type] -> <.8>;
49+
"t"[type] -> {<.8>};
5050
"x"[value] -> <.9>;
5151
});
5252
}
@@ -60,10 +60,14 @@ end
6060
[%%expect{|
6161
{
6262
"Fignore"[module] ->
63-
Abs<.14>(()/1, {
64-
"t"[type] -> <.11>;
65-
"x"[value] -> <.13>;
66-
});
63+
Abs<.14>
64+
(()/1,
65+
{
66+
"t"[type] -> {<.11>
67+
"Fresh"[constructor] -> {<.12>};
68+
};
69+
"x"[value] -> <.13>;
70+
});
6771
}
6872
module Fignore : S -> sig type t = Fresh val x : t end
6973
|}]
@@ -74,18 +78,23 @@ module Arg : S = struct
7478
end
7579
[%%expect{|
7680
{
77-
"Arg"[module] -> {<.18>
78-
"t"[type] -> <.15>;
79-
"x"[value] -> <.17>;
80-
};
81+
"Arg"[module] ->
82+
{<.18>
83+
"t"[type] -> {<.15>
84+
"T"[constructor] -> {<.16>};
85+
};
86+
"x"[value] -> <.17>;
87+
};
8188
}
8289
module Arg : S
8390
|}]
8491

8592
include Falias(Arg)
8693
[%%expect{|
8794
{
88-
"t"[type] -> <.15>;
95+
"t"[type] -> {<.15>
96+
"T"[constructor] -> {<.16>};
97+
};
8998
"x"[value] -> <.17>;
9099
}
91100
type t = Arg.t
@@ -95,7 +104,9 @@ val x : t = <abstr>
95104
include Finclude(Arg)
96105
[%%expect{|
97106
{
98-
"t"[type] -> <.15>;
107+
"t"[type] -> {<.15>
108+
"T"[constructor] -> {<.16>};
109+
};
99110
"x"[value] -> <.17>;
100111
}
101112
type t = Arg.t
@@ -105,7 +116,7 @@ val x : t = <abstr>
105116
include Fredef(Arg)
106117
[%%expect{|
107118
{
108-
"t"[type] -> <.8>;
119+
"t"[type] -> {<.8>};
109120
"x"[value] -> <.9>;
110121
}
111122
type t = Arg.t
@@ -115,7 +126,9 @@ val x : Arg.t = <abstr>
115126
include Fignore(Arg)
116127
[%%expect{|
117128
{
118-
"t"[type] -> <.11>;
129+
"t"[type] -> {<.11>
130+
"Fresh"[constructor] -> {<.12>};
131+
};
119132
"x"[value] -> <.13>;
120133
}
121134
type t = Fignore(Arg).t = Fresh
@@ -125,7 +138,7 @@ val x : t = Fresh
125138
include Falias(struct type t = int let x = 0 end)
126139
[%%expect{|
127140
{
128-
"t"[type] -> <.19>;
141+
"t"[type] -> {<.19>};
129142
"x"[value] -> <.20>;
130143
}
131144
type t = int
@@ -135,7 +148,7 @@ val x : t = 0
135148
include Finclude(struct type t = int let x = 0 end)
136149
[%%expect{|
137150
{
138-
"t"[type] -> <.21>;
151+
"t"[type] -> {<.21>};
139152
"x"[value] -> <.22>;
140153
}
141154
type t = int
@@ -145,7 +158,7 @@ val x : t = 0
145158
include Fredef(struct type t = int let x = 0 end)
146159
[%%expect{|
147160
{
148-
"t"[type] -> <.8>;
161+
"t"[type] -> {<.8>};
149162
"x"[value] -> <.9>;
150163
}
151164
type t = int
@@ -155,7 +168,9 @@ val x : int = 0
155168
include Fignore(struct type t = int let x = 0 end)
156169
[%%expect{|
157170
{
158-
"t"[type] -> <.11>;
171+
"t"[type] -> {<.11>
172+
"Fresh"[constructor] -> {<.12>};
173+
};
159174
"x"[value] -> <.13>;
160175
}
161176
type t = Fresh
@@ -168,18 +183,25 @@ module Fgen () = struct
168183
end
169184
[%%expect{|
170185
{
171-
"Fgen"[module] -> Abs<.30>(()/1, {
172-
"t"[type] -> <.27>;
173-
"x"[value] -> <.29>;
174-
});
186+
"Fgen"[module] ->
187+
Abs<.30>
188+
(()/1,
189+
{
190+
"t"[type] -> {<.27>
191+
"Fresher"[constructor] -> {<.28>};
192+
};
193+
"x"[value] -> <.29>;
194+
});
175195
}
176196
module Fgen : functor () -> sig type t = Fresher val x : t end
177197
|}]
178198

179199
include Fgen ()
180200
[%%expect{|
181201
{
182-
"t"[type] -> <.27>;
202+
"t"[type] -> {<.27>
203+
"Fresher"[constructor] -> {<.28>};
204+
};
183205
"x"[value] -> <.29>;
184206
}
185207
type t = Fresher

‎testsuite/tests/shapes/nested_types.ml‎

Lines changed: 50 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,50 @@
1+
(* TEST
2+
flags = "-dshape";
3+
expect;
4+
*)
5+
6+
module M : sig
7+
8+
exception Exn of { lbl_exn : int }
9+
type l = { lbl : int }
10+
type ext = ..
11+
type ext += Ext of { lbl_ext : int }
12+
type t = C of { lbl_cstr : int }
13+
end = struct
14+
exception Exn of { lbl_exn : int }
15+
type l = { lbl : int }
16+
type ext = ..
17+
type ext += Ext of { lbl_ext : int }
18+
type t = C of { lbl_cstr : int }
19+
end
20+
[%%expect{|
21+
{
22+
"M"[module] ->
23+
{<.37>
24+
"Exn"[extension constructor] -> {<.1>
25+
"lbl_exn"[label] -> <.0>;
26+
};
27+
"Ext"[extension constructor] -> {<.7>
28+
"lbl_ext"[label] -> <.6>;
29+
};
30+
"ext"[type] -> {<.5>};
31+
"l"[type] -> {<.3>
32+
"lbl"[label] -> <.4>;
33+
};
34+
"t"[type] ->
35+
{<.9>
36+
"C"[constructor] -> {<.11>
37+
"lbl_cstr"[label] -> <.10>;
38+
};
39+
};
40+
};
41+
}
42+
module M :
43+
sig
44+
exception Exn of { lbl_exn : int; }
45+
type l = { lbl : int; }
46+
type ext = ..
47+
type ext += Ext of { lbl_ext : int; }
48+
type t = C of { lbl_cstr : int; }
49+
end
50+
|}]

‎testsuite/tests/shapes/open_struct.ml‎

Lines changed: 37 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -18,18 +18,23 @@ module M : sig type t = A end
1818
include M
1919
[%%expect{|
2020
{
21-
"t"[type] -> <.0>;
21+
"t"[type] -> {<.0>
22+
"A"[constructor] -> {<.1>};
23+
};
2224
}
2325
type t = M.t = A
2426
|}]
2527

2628
module N = M
2729
[%%expect{|
2830
{
29-
"N"[module] -> Alias(<.3>
30-
{<.2>
31-
"t"[type] -> <.0>;
32-
});
31+
"N"[module] ->
32+
Alias(<.3>
33+
{<.2>
34+
"t"[type] -> {<.0>
35+
"A"[constructor] -> {<.1>};
36+
};
37+
});
3338
}
3439
module N = M
3540
|}]
@@ -46,7 +51,9 @@ end
4651
[%%expect{|
4752
{
4853
"M'"[module] -> {<.6>
49-
"t"[type] -> <.4>;
54+
"t"[type] -> {<.4>
55+
"A"[constructor] -> {<.5>};
56+
};
5057
};
5158
}
5259
module M' : sig type t = A end
@@ -55,10 +62,13 @@ module M' : sig type t = A end
5562
module N' = M'
5663
[%%expect{|
5764
{
58-
"N'"[module] -> Alias(<.7>
59-
{<.6>
60-
"t"[type] -> <.4>;
61-
});
65+
"N'"[module] ->
66+
Alias(<.7>
67+
{<.6>
68+
"t"[type] -> {<.4>
69+
"A"[constructor] -> {<.5>};
70+
};
71+
});
6272
}
6373
module N' = M'
6474
|}]
@@ -70,11 +80,14 @@ module Test = struct
7080
end
7181
[%%expect{|
7282
{
73-
"Test"[module] -> {<.11>
74-
"M"[module] -> {<.10>
75-
"t"[type] -> <.8>;
76-
};
83+
"Test"[module] ->
84+
{<.11>
85+
"M"[module] -> {<.10>
86+
"t"[type] -> {<.8>
87+
"A"[constructor] -> {<.9>};
88+
};
7789
};
90+
};
7891
}
7992
module Test : sig module M : sig type t = A end end
8093
|}]
@@ -83,7 +96,9 @@ include Test
8396
[%%expect{|
8497
{
8598
"M"[module] -> {<.10>
86-
"t"[type] -> <.8>;
99+
"t"[type] -> {<.8>
100+
"A"[constructor] -> {<.9>};
101+
};
87102
};
88103
}
89104
module M = Test.M
@@ -92,10 +107,13 @@ module M = Test.M
92107
module N = M
93108
[%%expect{|
94109
{
95-
"N"[module] -> Alias(<.12>
96-
{<.10>
97-
"t"[type] -> <.8>;
98-
});
110+
"N"[module] ->
111+
Alias(<.12>
112+
{<.10>
113+
"t"[type] -> {<.8>
114+
"A"[constructor] -> {<.9>};
115+
};
116+
});
99117
}
100118
module N = M
101119
|}]

0 commit comments

Comments
 (0)