The unpac monorepo manager self-hosting as a monorepo using unpac
Merge pull request #1826 from trefis/nondep-private
nondep_type_decl: expand to private abbrev instead of abstracting
authored by
Thomas Refis
and committed by
GitHub
9702af72
9924db8c
+180
-16
+4
Changes
+4
Changes
···
10
10
11
11
### Type system:
12
12
13
+
- GPR#1826: allow expanding a type to a private abbreviation instead of
14
+
abstracting when removing references to an identifier
15
+
(Thomas Refis and Leo White, review by Jacques Garrigue)
16
+
13
17
### Standard library:
14
18
15
19
- MPR#6701, GPR#1185, GPR#1803: make float_of_string and string_of_float
+137
testsuite/tests/typing-modules/nondep_private_abbrev.ml
+137
testsuite/tests/typing-modules/nondep_private_abbrev.ml
···
1
+
(* TEST
2
+
* expect
3
+
*)
4
+
5
+
module F(_ : sig end) : sig
6
+
type t = private int
7
+
end = struct
8
+
type t = int
9
+
end;;
10
+
[%%expect{|
11
+
module F : sig end -> sig type t = private int end
12
+
|}]
13
+
14
+
module Direct = F(struct end);;
15
+
[%%expect{|
16
+
module Direct : sig type t = private int end
17
+
|}]
18
+
19
+
module G(X : sig end) : sig
20
+
type t = F(X).t
21
+
end = F(X);;
22
+
[%%expect{|
23
+
module G : functor (X : sig end) -> sig type t = F(X).t end
24
+
|}]
25
+
26
+
module Indirect = G(struct end);;
27
+
[%%expect{|
28
+
module Indirect : sig type t = private int end
29
+
|}]
30
+
31
+
(* unroll_abbrev *)
32
+
33
+
module Pub(_ : sig end) = struct
34
+
type t = [ `Foo of t ]
35
+
end;;
36
+
[%%expect{|
37
+
module Pub : sig end -> sig type t = [ `Foo of t ] end
38
+
|}]
39
+
40
+
module Priv(_ : sig end) = struct
41
+
type t = private [ `Foo of t ]
42
+
end;;
43
+
[%%expect{|
44
+
module Priv : sig end -> sig type t = private [ `Foo of t ] end
45
+
|}]
46
+
47
+
module DirectPub = Pub(struct end);;
48
+
[%%expect{|
49
+
module DirectPub : sig type t = [ `Foo of t ] end
50
+
|}]
51
+
52
+
module DirectPriv = Priv(struct end);;
53
+
[%%expect{|
54
+
module DirectPriv : sig type t = private [ `Foo of t ] end
55
+
|}]
56
+
57
+
module H(X : sig end) : sig
58
+
type t = Pub(X).t
59
+
end = Pub(X);;
60
+
[%%expect{|
61
+
module H : functor (X : sig end) -> sig type t = Pub(X).t end
62
+
|}]
63
+
64
+
module I(X : sig end) : sig
65
+
type t = Priv(X).t
66
+
end = Priv(X);;
67
+
[%%expect{|
68
+
module I : functor (X : sig end) -> sig type t = Priv(X).t end
69
+
|}]
70
+
71
+
module IndirectPub = H(struct end);;
72
+
[%%expect{|
73
+
module IndirectPub : sig type t = [ `Foo of t ] end
74
+
|}]
75
+
76
+
(* The result would be
77
+
{[
78
+
type t = private [ `Foo of t ]
79
+
]}
80
+
if we were unrolling the abbrev. *)
81
+
module IndirectPriv = I(struct end);;
82
+
[%%expect{|
83
+
module IndirectPriv : sig type t end
84
+
|}]
85
+
86
+
(*** Test proposed by Jacques in
87
+
https://github.com/ocaml/ocaml/pull/1826#discussion_r194290729 ***)
88
+
89
+
(* Baseline *)
90
+
91
+
type t = private [ `Bar of int | `Foo of t -> int ];;
92
+
[%%expect{|
93
+
type t = private [ `Bar of int | `Foo of t -> int ]
94
+
|}]
95
+
96
+
module M : sig
97
+
type s = private [ `Bar of int | `Foo of 'a -> int ] as 'a
98
+
end = struct
99
+
type s = t
100
+
end;;
101
+
[%%expect{|
102
+
Line _, characters 6-29:
103
+
......struct
104
+
type s = t
105
+
end..
106
+
Error: Signature mismatch:
107
+
Modules do not match:
108
+
sig type s = t end
109
+
is not included in
110
+
sig type s = private [ `Bar of int | `Foo of 'a -> int ] as 'a end
111
+
Type declarations do not match:
112
+
type s = t
113
+
is not included in
114
+
type s = private [ `Bar of int | `Foo of 'a -> int ] as 'a
115
+
|}]
116
+
117
+
(* nondep_type_decl + nondep_type_rec *)
118
+
119
+
module Priv(_ : sig end) = struct
120
+
type t = private [ `Foo of t -> int | `Bar of int ]
121
+
end;;
122
+
[%%expect{|
123
+
module Priv :
124
+
sig end -> sig type t = private [ `Bar of int | `Foo of t -> int ] end
125
+
|}]
126
+
127
+
module I(X : sig end) : sig
128
+
type t = Priv(X).t
129
+
end = Priv(X);;
130
+
[%%expect{|
131
+
module I : functor (X : sig end) -> sig type t = Priv(X).t end
132
+
|}]
133
+
134
+
module IndirectPriv = I(struct end);;
135
+
[%%expect{|
136
+
module IndirectPriv : sig type t end
137
+
|}]
+1
testsuite/tests/typing-modules/ocamltests
+1
testsuite/tests/typing-modules/ocamltests
+18
-9
typing/ctype.ml
+18
-9
typing/ctype.ml
···
4369
4369
let clear_hash () =
4370
4370
TypeHash.clear nondep_hash; TypeHash.clear nondep_variants
4371
4371
4372
-
let rec nondep_type_rec env id ty =
4372
+
let rec nondep_type_rec ?(expand_private=false) env id ty =
4373
+
let expand_abbrev env t =
4374
+
if expand_private then expand_abbrev_opt env t else expand_abbrev env t
4375
+
in
4373
4376
match ty.desc with
4374
4377
Tvar _ | Tunivar _ -> ty
4375
4378
| Tlink ty -> nondep_type_rec env id ty
···
4382
4385
| Tconstr(p, tl, _abbrev) ->
4383
4386
if Path.isfree id p then
4384
4387
begin try
4385
-
Tlink (nondep_type_rec env id
4388
+
Tlink (nondep_type_rec ~expand_private env id
4386
4389
(expand_abbrev env (newty2 ty.level ty.desc)))
4387
4390
(*
4388
4391
The [Tlink] is important. The expanded type may be a
···
4460
4463
let tk =
4461
4464
try map_kind (nondep_type_rec env mid) decl.type_kind
4462
4465
with Not_found when is_covariant -> Type_abstract
4463
-
and tm =
4464
-
try match decl.type_manifest with
4465
-
None -> None
4466
+
and tm, priv =
4467
+
match decl.type_manifest with
4468
+
| None -> None, decl.type_private
4466
4469
| Some ty ->
4467
-
Some (unroll_abbrev id params (nondep_type_rec env mid ty))
4468
-
with Not_found when is_covariant ->
4469
-
None
4470
+
try Some (unroll_abbrev id params
4471
+
(nondep_type_rec env mid ty)),
4472
+
decl.type_private
4473
+
with Not_found when is_covariant ->
4474
+
clear_hash ();
4475
+
try Some (nondep_type_rec ~expand_private:true env mid ty),
4476
+
Private
4477
+
with Not_found ->
4478
+
None, decl.type_private
4470
4479
in
4471
4480
clear_hash ();
4472
4481
let priv =
4473
4482
match tm with
4474
4483
| Some ty when Btype.has_constr_row ty -> Private
4475
-
| _ -> decl.type_private
4484
+
| _ -> priv
4476
4485
in
4477
4486
{ type_params = params;
4478
4487
type_arity = decl.type_arity;
+20
-7
typing/typemod.ml
+20
-7
typing/typemod.ml
···
1384
1384
mty_res
1385
1385
| None ->
1386
1386
if generative then mty_res else
1387
-
try
1388
-
Mtype.nondep_supertype
1389
-
(Env.add_module ~arg:true param arg.mod_type env)
1390
-
param mty_res
1391
-
with Not_found ->
1392
-
raise(Error(smod.pmod_loc, env,
1393
-
Cannot_eliminate_dependency mty_functor))
1387
+
let env = Env.add_module ~arg:true param arg.mod_type env in
1388
+
let nondep_mty =
1389
+
try Mtype.nondep_supertype env param mty_res
1390
+
with Not_found ->
1391
+
raise(Error(smod.pmod_loc, env,
1392
+
Cannot_eliminate_dependency mty_functor))
1393
+
in
1394
+
begin match
1395
+
Includemod.modtypes ~loc:smod.pmod_loc env mty_res nondep_mty
1396
+
with
1397
+
| Tcoerce_none -> ()
1398
+
| _ ->
1399
+
fatal_error
1400
+
"unexpected coercion from original module type to \
1401
+
nondep_supertype one"
1402
+
| exception Includemod.Error _ ->
1403
+
fatal_error
1404
+
"nondep_supertype not included in original module type"
1405
+
end;
1406
+
nondep_mty
1394
1407
in
1395
1408
rm { mod_desc = Tmod_apply(funct, arg, coercion);
1396
1409
mod_type = mty_appl;