Skip to content

Commit de413fd

Browse files
lukemaurerlukemaurer
authored
Avoid needless dependency on parameter .cmi by introducing Parameter_name.t (#3708)
* Introduce `Global_module.Parameter_name.t` Takes the place of any `Global_module.t` or `Global_module.Name.t` that is known to be the name of a parameter. Can't have parameters. (Notably, even the current half-worked-out plans for parameterized parameters would actually keep this type in many places, so this isn't as much in the way as one might think.) * Don't call `global_of_global_name` on parameter names This has the benefit of not loading the .cmi file for something whose signature we don't need (say because the parameter is only used as part of an instance name). * Code review
1 parent db8aba1 commit de413fd

31 files changed

+413
-416
lines changed

‎driver/compile.ml

+1-4
Original file line numberDiff line numberDiff line change
@@ -108,10 +108,7 @@ let implementation_aux ~start_from ~source_file ~output_prefix
108108
let backend info typed =
109109
let as_arg_for =
110110
!Clflags.as_argument_for
111-
|> Option.map (fun param ->
112-
(* Currently, parameters don't have parameters, so we assume the argument
113-
list is empty *)
114-
Global_module.Name.create_no_args param)
111+
|> Option.map Global_module.Parameter_name.of_string
115112
in
116113
let bytecode = to_bytecode info typed ~as_arg_for in
117114
emit_bytecode info bytecode

‎driver/compile.mli

+1-1
Original file line numberDiff line numberDiff line change
@@ -33,7 +33,7 @@ val instance:
3333
val to_bytecode :
3434
Compile_common.info ->
3535
Typedtree.implementation ->
36-
as_arg_for:Global_module.Name.t option ->
36+
as_arg_for:Global_module.Parameter_name.t option ->
3737
Instruct.instruction list * Compilation_unit.Set.t *
3838
Lambda.main_module_block_format *
3939
Lambda.arg_descr option

‎driver/compile_common.ml

+2-3
Original file line numberDiff line numberDiff line change
@@ -99,9 +99,8 @@ let emit_signature info alerts tsg =
9999
Parameter
100100
else begin
101101
let cmi_arg_for =
102-
match !Clflags.as_argument_for with
103-
| Some arg_type -> Some (Global_module.Name.create_no_args arg_type)
104-
| None -> None
102+
!Clflags.as_argument_for
103+
|> Option.map Global_module.Parameter_name.of_string
105104
in
106105
Normal { cmi_impl = info.module_name; cmi_arg_for }
107106
end

‎driver/compmisc.ml

+1-2
Original file line numberDiff line numberDiff line change
@@ -61,8 +61,7 @@ let init_parameters () =
6161
let param_names = !Clflags.parameters in
6262
List.iter
6363
(fun param_name ->
64-
(* We don't (yet!) support parameterised parameters *)
65-
let param = Global_module.Name.create_no_args param_name in
64+
let param = Global_module.Parameter_name.of_string param_name in
6665
Env.register_parameter param
6766
)
6867
param_names

‎driver/instantiator.ml

+18-17
Original file line numberDiff line numberDiff line change
@@ -42,15 +42,15 @@ type error =
4242
compilation_unit : CU.t;
4343
filename : Misc.filepath;
4444
}
45-
| Missing_argument of { param : Global_module.Name.t }
45+
| Missing_argument of { param : Global_module.Parameter_name.t }
4646
| No_such_parameter of {
4747
base_unit : CU.t;
48-
available_params : Global_module.Name.t list;
49-
param : Global_module.Name.t;
48+
available_params : Global_module.Parameter_name.t list;
49+
param : Global_module.Parameter_name.t;
5050
arg : Global_module.Name.t;
5151
}
5252
| Repeated_parameter of {
53-
param : Global_module.Name.t;
53+
param : Global_module.Parameter_name.t;
5454
arg1 : CU.t;
5555
arg2 : CU.t;
5656
}
@@ -85,11 +85,11 @@ let instantiate
8585
let arg_pairs : CU.argument list =
8686
List.map
8787
(fun (param, (value, _)) : CU.argument ->
88-
{ param = CU.of_global_name param; value })
88+
{ param = CU.Name.of_parameter_name param; value })
8989
arg_infos
9090
in
91-
let arg_map : (CU.t * int) Global_module.Name.Map.t =
92-
match Global_module.Name.Map.of_list_checked arg_infos with
91+
let arg_map : (CU.t * int) Global_module.Parameter_name.Map.t =
92+
match Global_module.Parameter_name.Map.of_list_checked arg_infos with
9393
| Ok map -> map
9494
| Error (Duplicate { key; value1 = (arg1, _); value2 = (arg2, _) }) ->
9595
error (Repeated_parameter { param = key; arg1; arg2 })
@@ -138,7 +138,7 @@ let instantiate
138138
let arg_subst : Global_module.subst =
139139
global.visible_args
140140
|> List.map (fun ({ param; value } : Global_module.argument) -> param, value)
141-
|> Global_module.Name.Map.of_list
141+
|> Global_module.Parameter_name.Map.of_list
142142
in
143143
let runtime_params, main_module_block_size =
144144
match base_unit_info.ui_format with
@@ -154,18 +154,17 @@ let instantiate
154154
|> List.map (fun runtime_param : Translmod.runtime_arg ->
155155
match (runtime_param : Lambda.runtime_param) with
156156
| Rp_argument_block global ->
157-
let global_name = Global_module.to_name global in
158157
begin
159158
match
160-
Global_module.Name.Map.find_opt global_name arg_map
159+
Global_module.find_in_parameter_map global arg_map
161160
with
162161
| Some (ra_unit, ra_field_idx) ->
163162
Argument_block { ra_unit; ra_field_idx }
164163
| None ->
165164
(* This should have been caught by
166165
[Env.global_of_instance_compilation_unit] earlier *)
167166
Misc.fatal_errorf "Can't find value for %a"
168-
Global_module.Name.print global_name
167+
Global_module.print global
169168
end
170169
| Rp_main_module_block global ->
171170
(* Substitute away any references to parameters in [global] *)
@@ -192,7 +191,7 @@ module Style = Misc.Style
192191
let pp_parameters ppf params =
193192
fprintf ppf "@[<hov>%a@]"
194193
(pp_print_list ~pp_sep:pp_print_space
195-
(Style.as_inline_code Global_module.Name.print))
194+
(Style.as_inline_code Global_module.Parameter_name.print))
196195
params
197196

198197
let report_error ppf = function
@@ -231,18 +230,19 @@ let report_error ppf = function
231230
(Style.as_inline_code Location.print_filename) filename
232231
| Missing_argument { param } ->
233232
fprintf ppf "No argument given for parameter %a"
234-
(Style.as_inline_code Global_module.Name.print) param
233+
(Style.as_inline_code Global_module.Parameter_name.print) param
235234
| No_such_parameter { base_unit; available_params; param; arg } ->
236235
fprintf ppf
237236
"@[<hov>Module %a@ is an argument for parameter %a,@ \
238237
which is not a parameter of %a.@]@.\
239238
@[<hov>@{<hint>Hint@}: @[<hov>%a@ was compiled with %a.@]@]@.\
240239
@[<hov>@{<hint>Hint@}: @[<hov>Parameters of %a:@ %a@]@]"
241240
(Style.as_inline_code Global_module.Name.print) arg
242-
(Style.as_inline_code Global_module.Name.print) param
241+
(Style.as_inline_code Global_module.Parameter_name.print) param
243242
(Style.as_inline_code CU.print) base_unit
244243
(Style.as_inline_code Global_module.Name.print) arg
245-
(Style.as_clflag "-as-argument-for" Global_module.Name.print) param
244+
(Style.as_clflag "-as-argument-for" Global_module.Parameter_name.print)
245+
param
246246
(Style.as_inline_code CU.print) base_unit
247247
pp_parameters available_params
248248
| Repeated_parameter { param; arg1; arg2 } ->
@@ -254,10 +254,11 @@ let report_error ppf = function
254254
with %a.@]@]"
255255
(Style.as_inline_code CU.print) arg1
256256
(Style.as_inline_code CU.print) arg2
257-
(Style.as_inline_code Global_module.Name.print) param
257+
(Style.as_inline_code Global_module.Parameter_name.print) param
258258
(Style.as_inline_code CU.print) arg1
259259
(Style.as_inline_code CU.print) arg2
260-
(Style.as_clflag "-as-argument-for" Global_module.Name.print) param
260+
(Style.as_clflag "-as-argument-for" Global_module.Parameter_name.print)
261+
param
261262
let () =
262263
Location.register_error_of_exn
263264
(function

‎driver/instantiator.mli

+4-4
Original file line numberDiff line numberDiff line change
@@ -63,15 +63,15 @@ type error =
6363
compilation_unit : CU.t;
6464
filename : Misc.filepath;
6565
}
66-
| Missing_argument of { param : Global_module.Name.t }
66+
| Missing_argument of { param : Global_module.Parameter_name.t }
6767
| No_such_parameter of {
6868
base_unit : CU.t;
69-
available_params : Global_module.Name.t list;
70-
param : Global_module.Name.t;
69+
available_params : Global_module.Parameter_name.t list;
70+
param : Global_module.Parameter_name.t;
7171
arg : Global_module.Name.t
7272
}
7373
| Repeated_parameter of {
74-
param : Global_module.Name.t;
74+
param : Global_module.Parameter_name.t;
7575
arg1 : CU.t;
7676
arg2 : CU.t;
7777
}

‎driver/optcompile.ml

+1-4
Original file line numberDiff line numberDiff line change
@@ -133,10 +133,7 @@ let implementation_aux unix ~(flambda2 : flambda2) ~start_from
133133
let typed = structure, coercion, argument_coercion in
134134
let as_arg_for =
135135
!Clflags.as_argument_for
136-
|> Option.map (fun param ->
137-
(* Currently, parameters don't have parameters, so we assume the argument
138-
list is empty *)
139-
Global_module.Name.create_no_args param)
136+
|> Option.map Global_module.Parameter_name.of_string
140137
in
141138
if not (Config.flambda || Config.flambda2) then Clflags.set_oclassic ();
142139
compile_from_typed info typed ~unix ~transl_style ~pipeline ~as_arg_for

‎file_formats/cmi_format.ml

+3-3
Original file line numberDiff line numberDiff line change
@@ -23,7 +23,7 @@ type pers_flags =
2323
type kind =
2424
| Normal of {
2525
cmi_impl : Compilation_unit.t;
26-
cmi_arg_for : Global_module.Name.t option;
26+
cmi_arg_for : Global_module.Parameter_name.t option;
2727
}
2828
| Parameter
2929

@@ -65,15 +65,15 @@ type header = {
6565
header_kind : kind;
6666
header_globals : Global_module.With_precision.t array;
6767
header_sign : Serialized.signature;
68-
header_params : Global_module.t list;
68+
header_params : Global_module.Parameter_name.t list;
6969
}
7070

7171
type 'sg cmi_infos_generic = {
7272
cmi_name : Compilation_unit.Name.t;
7373
cmi_kind : kind;
7474
cmi_globals : Global_module.With_precision.t array;
7575
cmi_sign : 'sg;
76-
cmi_params : Global_module.t list;
76+
cmi_params : Global_module.Parameter_name.t list;
7777
cmi_crcs : crcs;
7878
cmi_flags : flags;
7979
}

‎file_formats/cmi_format.mli

+2-2
Original file line numberDiff line numberDiff line change
@@ -25,7 +25,7 @@ type kind =
2525
cmi_impl : Compilation_unit.t;
2626
(* If this module takes parameters, [cmi_impl] will be the functor that
2727
generates instances *)
28-
cmi_arg_for : Global_module.Name.t option;
28+
cmi_arg_for : Global_module.Parameter_name.t option;
2929
}
3030
| Parameter
3131

@@ -34,7 +34,7 @@ type 'sg cmi_infos_generic = {
3434
cmi_kind : kind;
3535
cmi_globals : Global_module.With_precision.t array;
3636
cmi_sign : 'sg;
37-
cmi_params : Global_module.t list; (* CR lmaurer: Should be [Parameter_name.t list] *)
37+
cmi_params : Global_module.Parameter_name.t list;
3838
cmi_crcs : Import_info.t array;
3939
cmi_flags : pers_flags list;
4040
}

‎flambda-backend/tests/typing/global_module_test.expected

+13-13
Original file line numberDiff line numberDiff line change
@@ -2,17 +2,18 @@
22
Tests of subst:
33

44
X { (X Unit) } = Unit
5-
Y{X} { (X Unit) } = Y[X:Unit]
6-
Y[X:Unit] { (X String) } = Y[X:Unit]
7-
Y[X:Unit] { (Y[X:Unit] String) } = String
8-
M{X}{Y:Y{X}} { (X A) } = M[X:A]{Y:Y[X:A]}
9-
M{X}{Y:Y{X}} { (X A) (Y B) } = M[X:A][Y:B]
5+
Y { (X Unit) } = Y
6+
Y { (X String) } = Y
7+
M{X}{Y} { (X A) } = M[X:A]{Y}
8+
M{X}{Y} { (X A) (Y B) } = M[X:A][Y:B]
109
X { (I Unit) } = X
11-
Y{X} { (I Unit) } = Y{X}
12-
Print{Conv[O:String]:Conv[O:String]{I}}{I}
13-
{ (I Unit) }
10+
Y { (I Unit) } = Y
11+
Print{Conv}{I} { (I Unit) } = Print[I:Unit]{Conv}
12+
Print{Conv}{I}
13+
{ (Conv Opaque{I}) (I Option{I}) }
1414
=
15-
Print[I:Unit]{Conv[O:String]:Conv[I:Unit][O:String]}
15+
Print[Conv:Opaque{I}][I:Option{I}]
16+
Print[Conv:Opaque{I}]{I} { (I Unit) } = Print[Conv:Opaque[I:Unit]][I:Unit]
1617

1718
Tests of check:
1819

@@ -22,7 +23,6 @@ check { (X String) } [] = false
2223
check { (X String) } [ X ] = true
2324
check { (I Unit) } [ I ] = true
2425
check { (I Unit) } [ O ] = false
25-
check { (I Unit) } [ Conv{I}{O}; I ] = true
26-
check { (Conv Opaque{I}) (O String) } [ Conv{I}{O}; I; O ] = true
27-
check { (Conv[O:String] Opaque{I}) } [ Conv{I}{O}; I; O ] = false
28-
check { (Conv[O:String] Opaque{I}) } [ Conv[O:String]{I}; I ] = true
26+
check { (I Unit) } [ Conv; I ] = true
27+
check { (I Option{I}) } [ Conv; I ] = true
28+
check { (I Option[I:Unit]) } [ Conv; I ] = true

0 commit comments

Comments
 (0)