diff --git a/.depend b/.depend index 9d0a640c8b6..62d5dc5955b 100644 --- a/.depend +++ b/.depend @@ -45,6 +45,23 @@ utils/clflags.cmx : \ utils/clflags.cmi : \ utils/profile.cmi \ utils/misc.cmi +utils/compilation_unit.cmo : \ + utils/misc.cmi \ + utils/int_replace_polymorphic_compare.cmi \ + utils/identifiable.cmi \ + typing/ident.cmi \ + utils/clflags.cmi \ + utils/compilation_unit.cmi +utils/compilation_unit.cmx : \ + utils/misc.cmx \ + utils/int_replace_polymorphic_compare.cmx \ + utils/identifiable.cmx \ + typing/ident.cmx \ + utils/clflags.cmx \ + utils/compilation_unit.cmi +utils/compilation_unit.cmi : \ + utils/identifiable.cmi \ + typing/ident.cmi utils/config.cmo : \ utils/config.cmi utils/config.cmx : \ @@ -75,6 +92,16 @@ utils/int_replace_polymorphic_compare.cmo : \ utils/int_replace_polymorphic_compare.cmx : \ utils/int_replace_polymorphic_compare.cmi utils/int_replace_polymorphic_compare.cmi : +utils/linkage_name.cmo : \ + utils/int_replace_polymorphic_compare.cmi \ + utils/identifiable.cmi \ + utils/linkage_name.cmi +utils/linkage_name.cmx : \ + utils/int_replace_polymorphic_compare.cmx \ + utils/identifiable.cmx \ + utils/linkage_name.cmi +utils/linkage_name.cmi : \ + utils/identifiable.cmi utils/load_path.cmo : \ utils/misc.cmi \ utils/local_store.cmi \ @@ -127,6 +154,25 @@ utils/strongly_connected_components.cmx : \ utils/misc.cmx \ utils/strongly_connected_components.cmi utils/strongly_connected_components.cmi : +utils/symbol.cmo : \ + utils/misc.cmi \ + utils/linkage_name.cmi \ + utils/identifiable.cmi \ + typing/ident.cmi \ + utils/compilation_unit.cmi \ + utils/symbol.cmi +utils/symbol.cmx : \ + utils/misc.cmx \ + utils/linkage_name.cmx \ + utils/identifiable.cmx \ + typing/ident.cmx \ + utils/compilation_unit.cmx \ + utils/symbol.cmi +utils/symbol.cmi : \ + utils/linkage_name.cmi \ + utils/identifiable.cmi \ + typing/ident.cmi \ + utils/compilation_unit.cmi utils/target_system.cmo : \ utils/misc.cmi \ utils/config.cmi \ @@ -1525,6 +1571,7 @@ typing/typedecl_variance.cmi : \ typing/env.cmi \ parsing/asttypes.cmi typing/typedtree.cmo : \ + utils/warnings.cmi \ typing/types.cmi \ typing/primitive.cmi \ typing/path.cmi \ @@ -1536,6 +1583,7 @@ typing/typedtree.cmo : \ parsing/asttypes.cmi \ typing/typedtree.cmi typing/typedtree.cmx : \ + utils/warnings.cmx \ typing/types.cmx \ typing/primitive.cmx \ typing/path.cmx \ @@ -1547,6 +1595,7 @@ typing/typedtree.cmx : \ parsing/asttypes.cmi \ typing/typedtree.cmi typing/typedtree.cmi : \ + utils/warnings.cmi \ typing/types.cmi \ typing/primitive.cmi \ typing/path.cmi \ @@ -1633,7 +1682,8 @@ typing/typemod.cmi : \ typing/includemod.cmi \ typing/ident.cmi \ typing/env.cmi \ - file_formats/cmi_format.cmi + file_formats/cmi_format.cmi \ + utils/clflags.cmi typing/typeopt.cmo : \ typing/types.cmi \ typing/typedtree.cmi \ @@ -1856,6 +1906,7 @@ bytecomp/bytelink.cmo : \ bytecomp/dll.cmi \ utils/consistbl.cmi \ utils/config.cmi \ + utils/compilation_unit.cmi \ file_formats/cmo_format.cmi \ utils/clflags.cmi \ utils/ccomp.cmi \ @@ -1874,6 +1925,7 @@ bytecomp/bytelink.cmx : \ bytecomp/dll.cmx \ utils/consistbl.cmx \ utils/config.cmx \ + utils/compilation_unit.cmx \ file_formats/cmo_format.cmi \ utils/clflags.cmx \ utils/ccomp.cmx \ @@ -1898,6 +1950,7 @@ bytecomp/bytepackager.cmo : \ typing/env.cmi \ bytecomp/emitcode.cmi \ utils/config.cmi \ + utils/compilation_unit.cmi \ file_formats/cmo_format.cmi \ utils/clflags.cmi \ bytecomp/bytelink.cmi \ @@ -1918,6 +1971,7 @@ bytecomp/bytepackager.cmx : \ typing/env.cmx \ bytecomp/emitcode.cmx \ utils/config.cmx \ + utils/compilation_unit.cmx \ file_formats/cmo_format.cmi \ utils/clflags.cmx \ bytecomp/bytelink.cmx \ @@ -1961,6 +2015,7 @@ bytecomp/emitcode.cmo : \ typing/ident.cmi \ typing/env.cmi \ utils/config.cmi \ + utils/compilation_unit.cmi \ file_formats/cmo_format.cmi \ utils/clflags.cmi \ bytecomp/bytegen.cmi \ @@ -1978,6 +2033,7 @@ bytecomp/emitcode.cmx : \ typing/ident.cmx \ typing/env.cmx \ utils/config.cmx \ + utils/compilation_unit.cmx \ file_formats/cmo_format.cmi \ utils/clflags.cmx \ bytecomp/bytegen.cmx \ @@ -2156,6 +2212,7 @@ asmcomp/asmgen.cmo : \ asmcomp/deadcode.cmi \ utils/config.cmi \ middle_end/compilenv.cmi \ + utils/compilation_unit.cmi \ asmcomp/comballoc.cmi \ asmcomp/coloring.cmi \ asmcomp/cmmgen.cmi \ @@ -2199,6 +2256,7 @@ asmcomp/asmgen.cmx : \ asmcomp/deadcode.cmx \ utils/config.cmx \ middle_end/compilenv.cmx \ + utils/compilation_unit.cmx \ asmcomp/comballoc.cmx \ asmcomp/coloring.cmx \ asmcomp/cmmgen.cmx \ @@ -2245,6 +2303,7 @@ asmcomp/asmlibrarian.cmx : \ asmcomp/asmlibrarian.cmi asmcomp/asmlibrarian.cmi : asmcomp/asmlink.cmo : \ + utils/symbol.cmi \ lambda/runtimedef.cmi \ utils/profile.cmi \ utils/misc.cmi \ @@ -2255,6 +2314,7 @@ asmcomp/asmlink.cmo : \ utils/consistbl.cmi \ utils/config.cmi \ middle_end/compilenv.cmi \ + utils/compilation_unit.cmi \ file_formats/cmx_format.cmi \ asmcomp/cmm_helpers.cmi \ asmcomp/cmm.cmi \ @@ -2263,6 +2323,7 @@ asmcomp/asmlink.cmo : \ asmcomp/asmgen.cmi \ asmcomp/asmlink.cmi asmcomp/asmlink.cmx : \ + utils/symbol.cmx \ lambda/runtimedef.cmx \ utils/profile.cmx \ utils/misc.cmx \ @@ -2273,6 +2334,7 @@ asmcomp/asmlink.cmx : \ utils/consistbl.cmx \ utils/config.cmx \ middle_end/compilenv.cmx \ + utils/compilation_unit.cmx \ file_formats/cmx_format.cmi \ asmcomp/cmm_helpers.cmx \ asmcomp/cmm.cmx \ @@ -2286,11 +2348,13 @@ asmcomp/asmlink.cmi : \ asmcomp/asmpackager.cmo : \ typing/typemod.cmi \ lambda/translmod.cmi \ + utils/symbol.cmi \ lambda/simplif.cmi \ utils/profile.cmi \ utils/misc.cmi \ parsing/location.cmi \ utils/load_path.cmi \ + utils/linkage_name.cmi \ lambda/lambda.cmi \ typing/ident.cmi \ middle_end/flambda/flambda_middle_end.cmi \ @@ -2299,7 +2363,7 @@ asmcomp/asmpackager.cmo : \ typing/env.cmi \ utils/config.cmi \ middle_end/compilenv.cmi \ - middle_end/compilation_unit.cmi \ + utils/compilation_unit.cmi \ file_formats/cmx_format.cmi \ middle_end/closure/closure_middle_end.cmi \ utils/clflags.cmi \ @@ -2310,11 +2374,13 @@ asmcomp/asmpackager.cmo : \ asmcomp/asmpackager.cmx : \ typing/typemod.cmx \ lambda/translmod.cmx \ + utils/symbol.cmx \ lambda/simplif.cmx \ utils/profile.cmx \ utils/misc.cmx \ parsing/location.cmx \ utils/load_path.cmx \ + utils/linkage_name.cmx \ lambda/lambda.cmx \ typing/ident.cmx \ middle_end/flambda/flambda_middle_end.cmx \ @@ -2323,7 +2389,7 @@ asmcomp/asmpackager.cmx : \ typing/env.cmx \ utils/config.cmx \ middle_end/compilenv.cmx \ - middle_end/compilation_unit.cmx \ + utils/compilation_unit.cmx \ file_formats/cmx_format.cmi \ middle_end/closure/closure_middle_end.cmx \ utils/clflags.cmx \ @@ -2385,15 +2451,18 @@ asmcomp/cmm.cmi : \ parsing/asttypes.cmi asmcomp/cmm_helpers.cmo : \ utils/targetint.cmi \ + utils/symbol.cmi \ lambda/switch.cmi \ asmcomp/strmatch.cmi \ asmcomp/proc.cmi \ typing/primitive.cmi \ utils/misc.cmi \ + utils/linkage_name.cmi \ lambda/lambda.cmi \ lambda/debuginfo.cmi \ utils/config.cmi \ middle_end/compilenv.cmi \ + utils/compilation_unit.cmi \ file_formats/cmxs_format.cmi \ file_formats/cmx_format.cmi \ asmcomp/cmmgen_state.cmi \ @@ -2407,15 +2476,18 @@ asmcomp/cmm_helpers.cmo : \ asmcomp/cmm_helpers.cmi asmcomp/cmm_helpers.cmx : \ utils/targetint.cmx \ + utils/symbol.cmx \ lambda/switch.cmx \ asmcomp/strmatch.cmx \ asmcomp/proc.cmx \ typing/primitive.cmx \ utils/misc.cmx \ + utils/linkage_name.cmx \ lambda/lambda.cmx \ lambda/debuginfo.cmx \ utils/config.cmx \ middle_end/compilenv.cmx \ + utils/compilation_unit.cmx \ file_formats/cmxs_format.cmi \ file_formats/cmx_format.cmi \ asmcomp/cmmgen_state.cmx \ @@ -2429,9 +2501,11 @@ asmcomp/cmm_helpers.cmx : \ asmcomp/cmm_helpers.cmi asmcomp/cmm_helpers.cmi : \ utils/targetint.cmi \ + utils/symbol.cmi \ typing/primitive.cmi \ lambda/lambda.cmi \ lambda/debuginfo.cmi \ + utils/compilation_unit.cmi \ file_formats/cmx_format.cmi \ asmcomp/cmmgen_state.cmi \ asmcomp/cmm.cmi \ @@ -2568,7 +2642,7 @@ asmcomp/emit.cmo : \ utils/domainstate.cmi \ lambda/debuginfo.cmi \ utils/config.cmi \ - middle_end/compilenv.cmi \ + asmcomp/cmm_helpers.cmi \ asmcomp/cmm.cmi \ utils/clflags.cmi \ asmcomp/branch_relaxation.cmi \ @@ -2592,7 +2666,7 @@ asmcomp/emit.cmx : \ utils/domainstate.cmx \ lambda/debuginfo.cmx \ utils/config.cmx \ - middle_end/compilenv.cmx \ + asmcomp/cmm_helpers.cmx \ asmcomp/cmm.cmx \ utils/clflags.cmx \ asmcomp/branch_relaxation.cmx \ @@ -3064,10 +3138,10 @@ asmcomp/x86_proc.cmx : \ asmcomp/x86_proc.cmi : \ asmcomp/x86_ast.cmi middle_end/backend_intf.cmi : \ - middle_end/symbol.cmi \ + utils/symbol.cmi \ middle_end/flambda/simple_value_approx.cmi \ typing/ident.cmi \ - middle_end/flambda/base_types/closure_id.cmi + utils/compilation_unit.cmi middle_end/backend_var.cmo : \ typing/path.cmi \ typing/ident.cmi \ @@ -3124,75 +3198,53 @@ middle_end/clambda_primitives.cmi : \ typing/types.cmi \ typing/primitive.cmi \ lambda/lambda.cmi -middle_end/compilation_unit.cmo : \ - utils/misc.cmi \ - middle_end/linkage_name.cmi \ - utils/int_replace_polymorphic_compare.cmi \ - utils/identifiable.cmi \ - typing/ident.cmi \ - middle_end/compilation_unit.cmi -middle_end/compilation_unit.cmx : \ - utils/misc.cmx \ - middle_end/linkage_name.cmx \ - utils/int_replace_polymorphic_compare.cmx \ - utils/identifiable.cmx \ - typing/ident.cmx \ - middle_end/compilation_unit.cmi -middle_end/compilation_unit.cmi : \ - middle_end/linkage_name.cmi \ - utils/identifiable.cmi \ - typing/ident.cmi middle_end/compilenv.cmo : \ utils/warnings.cmi \ - middle_end/symbol.cmi \ + utils/symbol.cmi \ middle_end/flambda/simple_value_approx.cmi \ middle_end/flambda/base_types/set_of_closures_id.cmi \ typing/path.cmi \ utils/misc.cmi \ parsing/location.cmi \ utils/load_path.cmi \ - middle_end/linkage_name.cmi \ + utils/linkage_name.cmi \ typing/ident.cmi \ middle_end/flambda/export_info.cmi \ typing/env.cmi \ utils/config.cmi \ - middle_end/compilation_unit.cmi \ + utils/compilation_unit.cmi \ file_formats/cmx_format.cmi \ - middle_end/flambda/base_types/closure_id.cmi \ utils/clflags.cmi \ middle_end/clambda.cmi \ middle_end/compilenv.cmi middle_end/compilenv.cmx : \ utils/warnings.cmx \ - middle_end/symbol.cmx \ + utils/symbol.cmx \ middle_end/flambda/simple_value_approx.cmx \ middle_end/flambda/base_types/set_of_closures_id.cmx \ typing/path.cmx \ utils/misc.cmx \ parsing/location.cmx \ utils/load_path.cmx \ - middle_end/linkage_name.cmx \ + utils/linkage_name.cmx \ typing/ident.cmx \ middle_end/flambda/export_info.cmx \ typing/env.cmx \ utils/config.cmx \ - middle_end/compilation_unit.cmx \ + utils/compilation_unit.cmx \ file_formats/cmx_format.cmi \ - middle_end/flambda/base_types/closure_id.cmx \ utils/clflags.cmx \ middle_end/clambda.cmx \ middle_end/compilenv.cmi middle_end/compilenv.cmi : \ - middle_end/symbol.cmi \ + utils/symbol.cmi \ middle_end/flambda/simple_value_approx.cmi \ middle_end/flambda/base_types/set_of_closures_id.cmi \ - middle_end/linkage_name.cmi \ lambda/lambda.cmi \ typing/ident.cmi \ middle_end/flambda/export_info.cmi \ - middle_end/compilation_unit.cmi \ + utils/compilation_unit.cmi \ file_formats/cmx_format.cmi \ - middle_end/flambda/base_types/closure_id.cmi \ middle_end/clambda.cmi middle_end/convert_primitives.cmo : \ lambda/printlambda.cmi \ @@ -3223,16 +3275,6 @@ middle_end/internal_variable_names.cmx : \ middle_end/internal_variable_names.cmi middle_end/internal_variable_names.cmi : \ lambda/lambda.cmi -middle_end/linkage_name.cmo : \ - utils/int_replace_polymorphic_compare.cmi \ - utils/identifiable.cmi \ - middle_end/linkage_name.cmi -middle_end/linkage_name.cmx : \ - utils/int_replace_polymorphic_compare.cmx \ - utils/identifiable.cmx \ - middle_end/linkage_name.cmi -middle_end/linkage_name.cmi : \ - utils/identifiable.cmi middle_end/printclambda.cmo : \ lambda/printlambda.cmi \ middle_end/printclambda_primitives.cmi \ @@ -3275,34 +3317,30 @@ middle_end/semantics_of_primitives.cmx : \ middle_end/semantics_of_primitives.cmi middle_end/semantics_of_primitives.cmi : \ middle_end/clambda_primitives.cmi -middle_end/symbol.cmo : \ +middle_end/symbol_utils.cmo : \ middle_end/variable.cmi \ - utils/misc.cmi \ - middle_end/linkage_name.cmi \ - utils/int_replace_polymorphic_compare.cmi \ - utils/identifiable.cmi \ - middle_end/compilation_unit.cmi \ - middle_end/symbol.cmi -middle_end/symbol.cmx : \ + utils/symbol.cmi \ + utils/compilation_unit.cmi \ + middle_end/flambda/base_types/closure_id.cmi \ + middle_end/symbol_utils.cmi +middle_end/symbol_utils.cmx : \ middle_end/variable.cmx \ - utils/misc.cmx \ - middle_end/linkage_name.cmx \ - utils/int_replace_polymorphic_compare.cmx \ - utils/identifiable.cmx \ - middle_end/compilation_unit.cmx \ - middle_end/symbol.cmi -middle_end/symbol.cmi : \ + utils/symbol.cmx \ + utils/compilation_unit.cmx \ + middle_end/flambda/base_types/closure_id.cmx \ + middle_end/symbol_utils.cmi +middle_end/symbol_utils.cmi : \ middle_end/variable.cmi \ - middle_end/linkage_name.cmi \ - utils/identifiable.cmi \ - middle_end/compilation_unit.cmi + utils/symbol.cmi \ + utils/compilation_unit.cmi \ + middle_end/flambda/base_types/closure_id.cmi middle_end/variable.cmo : \ utils/misc.cmi \ middle_end/internal_variable_names.cmi \ utils/int_replace_polymorphic_compare.cmi \ utils/identifiable.cmi \ typing/ident.cmi \ - middle_end/compilation_unit.cmi \ + utils/compilation_unit.cmi \ middle_end/variable.cmi middle_end/variable.cmx : \ utils/misc.cmx \ @@ -3310,13 +3348,13 @@ middle_end/variable.cmx : \ utils/int_replace_polymorphic_compare.cmx \ utils/identifiable.cmx \ typing/ident.cmx \ - middle_end/compilation_unit.cmx \ + utils/compilation_unit.cmx \ middle_end/variable.cmi middle_end/variable.cmi : \ middle_end/internal_variable_names.cmi \ utils/identifiable.cmi \ typing/ident.cmi \ - middle_end/compilation_unit.cmi + utils/compilation_unit.cmi lambda/debuginfo.cmo : \ parsing/location.cmi \ utils/int_replace_polymorphic_compare.cmi \ @@ -3564,6 +3602,7 @@ lambda/translcomprehension.cmi : \ lambda/lambda.cmi \ lambda/debuginfo.cmi lambda/translcore.cmo : \ + utils/warnings.cmi \ typing/types.cmi \ typing/typeopt.cmi \ typing/typedtree.cmi \ @@ -3593,6 +3632,7 @@ lambda/translcore.cmo : \ parsing/asttypes.cmi \ lambda/translcore.cmi lambda/translcore.cmx : \ + utils/warnings.cmx \ typing/types.cmx \ typing/typeopt.cmx \ typing/typedtree.cmx \ @@ -3770,7 +3810,8 @@ file_formats/cmi_format.cmi : \ file_formats/cmo_format.cmi : \ utils/misc.cmi \ lambda/lambda.cmi \ - typing/ident.cmi + typing/ident.cmi \ + utils/compilation_unit.cmi file_formats/cmt_format.cmo : \ typing/types.cmi \ typing/typedtree.cmi \ @@ -3808,14 +3849,17 @@ file_formats/cmx_format.cmi : \ utils/misc.cmi \ lambda/lambda.cmi \ middle_end/flambda/export_info.cmi \ + utils/compilation_unit.cmi \ middle_end/clambda.cmi file_formats/cmxs_format.cmi : \ - utils/misc.cmi + utils/misc.cmi \ + utils/compilation_unit.cmi file_formats/linear_format.cmo : \ utils/misc.cmi \ parsing/location.cmi \ asmcomp/linear.cmi \ utils/config.cmi \ + utils/compilation_unit.cmi \ asmcomp/cmm.cmi \ file_formats/linear_format.cmi file_formats/linear_format.cmx : \ @@ -3823,13 +3867,16 @@ file_formats/linear_format.cmx : \ parsing/location.cmx \ asmcomp/linear.cmx \ utils/config.cmx \ + utils/compilation_unit.cmx \ asmcomp/cmm.cmx \ file_formats/linear_format.cmi file_formats/linear_format.cmi : \ asmcomp/linear.cmi \ + utils/compilation_unit.cmi \ asmcomp/cmm.cmi middle_end/closure/closure.cmo : \ utils/warnings.cmi \ + utils/symbol.cmi \ lambda/switch.cmi \ lambda/simplif.cmi \ middle_end/semantics_of_primitives.cmi \ @@ -3837,6 +3884,7 @@ middle_end/closure/closure.cmo : \ utils/numbers.cmi \ utils/misc.cmi \ parsing/location.cmi \ + utils/linkage_name.cmi \ lambda/lambda.cmi \ typing/ident.cmi \ typing/env.cmi \ @@ -3844,6 +3892,7 @@ middle_end/closure/closure.cmo : \ middle_end/convert_primitives.cmi \ utils/config.cmi \ middle_end/compilenv.cmi \ + utils/compilation_unit.cmi \ utils/clflags.cmi \ middle_end/clambda_primitives.cmi \ middle_end/clambda.cmi \ @@ -3853,6 +3902,7 @@ middle_end/closure/closure.cmo : \ middle_end/closure/closure.cmi middle_end/closure/closure.cmx : \ utils/warnings.cmx \ + utils/symbol.cmx \ lambda/switch.cmx \ lambda/simplif.cmx \ middle_end/semantics_of_primitives.cmx \ @@ -3860,6 +3910,7 @@ middle_end/closure/closure.cmx : \ utils/numbers.cmx \ utils/misc.cmx \ parsing/location.cmx \ + utils/linkage_name.cmx \ lambda/lambda.cmx \ typing/ident.cmx \ typing/env.cmx \ @@ -3867,6 +3918,7 @@ middle_end/closure/closure.cmx : \ middle_end/convert_primitives.cmx \ utils/config.cmx \ middle_end/compilenv.cmx \ + utils/compilation_unit.cmx \ utils/clflags.cmx \ middle_end/clambda_primitives.cmx \ middle_end/clambda.cmx \ @@ -3879,21 +3931,27 @@ middle_end/closure/closure.cmi : \ middle_end/clambda.cmi \ middle_end/backend_intf.cmi middle_end/closure/closure_middle_end.cmo : \ + utils/symbol.cmi \ middle_end/printclambda.cmi \ typing/path.cmi \ + utils/linkage_name.cmi \ lambda/lambda.cmi \ typing/ident.cmi \ middle_end/compilenv.cmi \ + utils/compilation_unit.cmi \ middle_end/closure/closure.cmi \ utils/clflags.cmi \ middle_end/clambda.cmi \ middle_end/closure/closure_middle_end.cmi middle_end/closure/closure_middle_end.cmx : \ + utils/symbol.cmx \ middle_end/printclambda.cmx \ typing/path.cmx \ + utils/linkage_name.cmx \ lambda/lambda.cmx \ typing/ident.cmx \ middle_end/compilenv.cmx \ + utils/compilation_unit.cmx \ middle_end/closure/closure.cmx \ utils/clflags.cmx \ middle_end/clambda.cmx \ @@ -3906,7 +3964,7 @@ middle_end/flambda/alias_analysis.cmo : \ middle_end/variable.cmi \ middle_end/flambda/base_types/var_within_closure.cmi \ middle_end/flambda/base_types/tag.cmi \ - middle_end/symbol.cmi \ + utils/symbol.cmi \ utils/misc.cmi \ lambda/lambda.cmi \ utils/int_replace_polymorphic_compare.cmi \ @@ -3917,7 +3975,7 @@ middle_end/flambda/alias_analysis.cmx : \ middle_end/variable.cmx \ middle_end/flambda/base_types/var_within_closure.cmx \ middle_end/flambda/base_types/tag.cmx \ - middle_end/symbol.cmx \ + utils/symbol.cmx \ utils/misc.cmx \ lambda/lambda.cmx \ utils/int_replace_polymorphic_compare.cmx \ @@ -3927,7 +3985,7 @@ middle_end/flambda/alias_analysis.cmx : \ middle_end/flambda/alias_analysis.cmi : \ middle_end/variable.cmi \ middle_end/flambda/base_types/tag.cmi \ - middle_end/symbol.cmi \ + utils/symbol.cmi \ lambda/lambda.cmi \ middle_end/flambda/flambda.cmi \ middle_end/flambda/allocated_const.cmi @@ -3989,7 +4047,7 @@ middle_end/flambda/build_export_info.cmo : \ middle_end/flambda/base_types/var_within_closure.cmi \ middle_end/flambda/traverse_for_exported_symbols.cmi \ middle_end/flambda/base_types/tag.cmi \ - middle_end/symbol.cmi \ + utils/symbol.cmi \ middle_end/flambda/simple_value_approx.cmi \ middle_end/flambda/base_types/set_of_closures_id.cmi \ utils/misc.cmi \ @@ -4001,10 +4059,9 @@ middle_end/flambda/build_export_info.cmo : \ middle_end/flambda/export_info.cmi \ middle_end/flambda/base_types/export_id.cmi \ middle_end/compilenv.cmi \ - middle_end/compilation_unit.cmi \ + utils/compilation_unit.cmi \ middle_end/flambda/base_types/closure_id.cmi \ utils/clflags.cmi \ - middle_end/backend_intf.cmi \ middle_end/flambda/allocated_const.cmi \ middle_end/flambda/build_export_info.cmi middle_end/flambda/build_export_info.cmx : \ @@ -4012,7 +4069,7 @@ middle_end/flambda/build_export_info.cmx : \ middle_end/flambda/base_types/var_within_closure.cmx \ middle_end/flambda/traverse_for_exported_symbols.cmx \ middle_end/flambda/base_types/tag.cmx \ - middle_end/symbol.cmx \ + utils/symbol.cmx \ middle_end/flambda/simple_value_approx.cmx \ middle_end/flambda/base_types/set_of_closures_id.cmx \ utils/misc.cmx \ @@ -4024,20 +4081,19 @@ middle_end/flambda/build_export_info.cmx : \ middle_end/flambda/export_info.cmx \ middle_end/flambda/base_types/export_id.cmx \ middle_end/compilenv.cmx \ - middle_end/compilation_unit.cmx \ + utils/compilation_unit.cmx \ middle_end/flambda/base_types/closure_id.cmx \ utils/clflags.cmx \ - middle_end/backend_intf.cmi \ middle_end/flambda/allocated_const.cmx \ middle_end/flambda/build_export_info.cmi middle_end/flambda/build_export_info.cmi : \ middle_end/flambda/flambda.cmi \ - middle_end/flambda/export_info.cmi \ - middle_end/backend_intf.cmi + middle_end/flambda/export_info.cmi middle_end/flambda/closure_conversion.cmo : \ middle_end/variable.cmi \ middle_end/flambda/base_types/tag.cmi \ - middle_end/symbol.cmi \ + middle_end/symbol_utils.cmi \ + utils/symbol.cmi \ middle_end/flambda/base_types/static_exception.cmi \ lambda/simplif.cmi \ typing/predef.cmi \ @@ -4055,7 +4111,7 @@ middle_end/flambda/closure_conversion.cmo : \ lambda/debuginfo.cmi \ middle_end/convert_primitives.cmi \ utils/config.cmi \ - middle_end/compilation_unit.cmi \ + utils/compilation_unit.cmi \ middle_end/flambda/base_types/closure_origin.cmi \ middle_end/flambda/base_types/closure_id.cmi \ middle_end/flambda/closure_conversion_aux.cmi \ @@ -4066,7 +4122,8 @@ middle_end/flambda/closure_conversion.cmo : \ middle_end/flambda/closure_conversion.cmx : \ middle_end/variable.cmx \ middle_end/flambda/base_types/tag.cmx \ - middle_end/symbol.cmx \ + middle_end/symbol_utils.cmx \ + utils/symbol.cmx \ middle_end/flambda/base_types/static_exception.cmx \ lambda/simplif.cmx \ typing/predef.cmx \ @@ -4084,7 +4141,7 @@ middle_end/flambda/closure_conversion.cmx : \ lambda/debuginfo.cmx \ middle_end/convert_primitives.cmx \ utils/config.cmx \ - middle_end/compilation_unit.cmx \ + utils/compilation_unit.cmx \ middle_end/flambda/base_types/closure_origin.cmx \ middle_end/flambda/base_types/closure_id.cmx \ middle_end/flambda/closure_conversion_aux.cmx \ @@ -4099,7 +4156,7 @@ middle_end/flambda/closure_conversion.cmi : \ middle_end/backend_intf.cmi middle_end/flambda/closure_conversion_aux.cmo : \ middle_end/variable.cmi \ - middle_end/symbol.cmi \ + utils/symbol.cmi \ middle_end/flambda/base_types/static_exception.cmi \ utils/numbers.cmi \ middle_end/flambda/base_types/mutable_variable.cmi \ @@ -4110,7 +4167,7 @@ middle_end/flambda/closure_conversion_aux.cmo : \ middle_end/flambda/closure_conversion_aux.cmi middle_end/flambda/closure_conversion_aux.cmx : \ middle_end/variable.cmx \ - middle_end/symbol.cmx \ + utils/symbol.cmx \ middle_end/flambda/base_types/static_exception.cmx \ utils/numbers.cmx \ middle_end/flambda/base_types/mutable_variable.cmx \ @@ -4121,7 +4178,7 @@ middle_end/flambda/closure_conversion_aux.cmx : \ middle_end/flambda/closure_conversion_aux.cmi middle_end/flambda/closure_conversion_aux.cmi : \ middle_end/variable.cmi \ - middle_end/symbol.cmi \ + utils/symbol.cmi \ middle_end/flambda/base_types/static_exception.cmi \ middle_end/flambda/base_types/mutable_variable.cmi \ lambda/lambda.cmi \ @@ -4164,41 +4221,41 @@ middle_end/flambda/export_info.cmo : \ middle_end/variable.cmi \ middle_end/flambda/base_types/var_within_closure.cmi \ middle_end/flambda/base_types/tag.cmi \ - middle_end/symbol.cmi \ + utils/symbol.cmi \ middle_end/flambda/simple_value_approx.cmi \ middle_end/flambda/base_types/set_of_closures_id.cmi \ middle_end/flambda/flambda.cmi \ middle_end/flambda/base_types/export_id.cmi \ - middle_end/compilation_unit.cmi \ + utils/compilation_unit.cmi \ middle_end/flambda/base_types/closure_id.cmi \ middle_end/flambda/export_info.cmi middle_end/flambda/export_info.cmx : \ middle_end/variable.cmx \ middle_end/flambda/base_types/var_within_closure.cmx \ middle_end/flambda/base_types/tag.cmx \ - middle_end/symbol.cmx \ + utils/symbol.cmx \ middle_end/flambda/simple_value_approx.cmx \ middle_end/flambda/base_types/set_of_closures_id.cmx \ middle_end/flambda/flambda.cmx \ middle_end/flambda/base_types/export_id.cmx \ - middle_end/compilation_unit.cmx \ + utils/compilation_unit.cmx \ middle_end/flambda/base_types/closure_id.cmx \ middle_end/flambda/export_info.cmi middle_end/flambda/export_info.cmi : \ middle_end/variable.cmi \ middle_end/flambda/base_types/var_within_closure.cmi \ middle_end/flambda/base_types/tag.cmi \ - middle_end/symbol.cmi \ + utils/symbol.cmi \ middle_end/flambda/simple_value_approx.cmi \ middle_end/flambda/base_types/set_of_closures_id.cmi \ middle_end/flambda/flambda.cmi \ middle_end/flambda/base_types/export_id.cmi \ - middle_end/compilation_unit.cmi \ + utils/compilation_unit.cmi \ middle_end/flambda/base_types/closure_id.cmi middle_end/flambda/export_info_for_pack.cmo : \ middle_end/variable.cmi \ middle_end/flambda/base_types/var_within_closure.cmi \ - middle_end/symbol.cmi \ + utils/symbol.cmi \ middle_end/flambda/simple_value_approx.cmi \ middle_end/flambda/base_types/set_of_closures_origin.cmi \ middle_end/flambda/base_types/set_of_closures_id.cmi \ @@ -4206,13 +4263,13 @@ middle_end/flambda/export_info_for_pack.cmo : \ middle_end/flambda/flambda.cmi \ middle_end/flambda/export_info.cmi \ middle_end/flambda/base_types/export_id.cmi \ - middle_end/compilation_unit.cmi \ + utils/compilation_unit.cmi \ middle_end/flambda/base_types/closure_id.cmi \ middle_end/flambda/export_info_for_pack.cmi middle_end/flambda/export_info_for_pack.cmx : \ middle_end/variable.cmx \ middle_end/flambda/base_types/var_within_closure.cmx \ - middle_end/symbol.cmx \ + utils/symbol.cmx \ middle_end/flambda/simple_value_approx.cmx \ middle_end/flambda/base_types/set_of_closures_origin.cmx \ middle_end/flambda/base_types/set_of_closures_id.cmx \ @@ -4220,12 +4277,12 @@ middle_end/flambda/export_info_for_pack.cmx : \ middle_end/flambda/flambda.cmx \ middle_end/flambda/export_info.cmx \ middle_end/flambda/base_types/export_id.cmx \ - middle_end/compilation_unit.cmx \ + utils/compilation_unit.cmx \ middle_end/flambda/base_types/closure_id.cmx \ middle_end/flambda/export_info_for_pack.cmi middle_end/flambda/export_info_for_pack.cmi : \ middle_end/flambda/export_info.cmi \ - middle_end/compilation_unit.cmi + utils/compilation_unit.cmi middle_end/flambda/extract_projections.cmo : \ middle_end/variable.cmi \ middle_end/flambda/base_types/var_within_closure.cmi \ @@ -4261,7 +4318,6 @@ middle_end/flambda/find_recursive_functions.cmo : \ utils/int_replace_polymorphic_compare.cmi \ middle_end/flambda/flambda_utils.cmi \ middle_end/flambda/flambda.cmi \ - middle_end/backend_intf.cmi \ middle_end/flambda/find_recursive_functions.cmi middle_end/flambda/find_recursive_functions.cmx : \ middle_end/variable.cmx \ @@ -4269,16 +4325,14 @@ middle_end/flambda/find_recursive_functions.cmx : \ utils/int_replace_polymorphic_compare.cmx \ middle_end/flambda/flambda_utils.cmx \ middle_end/flambda/flambda.cmx \ - middle_end/backend_intf.cmi \ middle_end/flambda/find_recursive_functions.cmi middle_end/flambda/find_recursive_functions.cmi : \ middle_end/variable.cmi \ - middle_end/flambda/flambda.cmi \ - middle_end/backend_intf.cmi + middle_end/flambda/flambda.cmi middle_end/flambda/flambda.cmo : \ middle_end/variable.cmi \ middle_end/flambda/base_types/tag.cmi \ - middle_end/symbol.cmi \ + utils/symbol.cmi \ middle_end/flambda/base_types/static_exception.cmi \ middle_end/flambda/base_types/set_of_closures_origin.cmi \ middle_end/flambda/base_types/set_of_closures_id.cmi \ @@ -4293,7 +4347,7 @@ middle_end/flambda/flambda.cmo : \ utils/int_replace_polymorphic_compare.cmi \ utils/identifiable.cmi \ lambda/debuginfo.cmi \ - middle_end/compilation_unit.cmi \ + utils/compilation_unit.cmi \ middle_end/flambda/base_types/closure_origin.cmi \ middle_end/flambda/base_types/closure_id.cmi \ utils/clflags.cmi \ @@ -4304,7 +4358,7 @@ middle_end/flambda/flambda.cmo : \ middle_end/flambda/flambda.cmx : \ middle_end/variable.cmx \ middle_end/flambda/base_types/tag.cmx \ - middle_end/symbol.cmx \ + utils/symbol.cmx \ middle_end/flambda/base_types/static_exception.cmx \ middle_end/flambda/base_types/set_of_closures_origin.cmx \ middle_end/flambda/base_types/set_of_closures_id.cmx \ @@ -4319,7 +4373,7 @@ middle_end/flambda/flambda.cmx : \ utils/int_replace_polymorphic_compare.cmx \ utils/identifiable.cmx \ lambda/debuginfo.cmx \ - middle_end/compilation_unit.cmx \ + utils/compilation_unit.cmx \ middle_end/flambda/base_types/closure_origin.cmx \ middle_end/flambda/base_types/closure_id.cmx \ utils/clflags.cmx \ @@ -4330,7 +4384,7 @@ middle_end/flambda/flambda.cmx : \ middle_end/flambda/flambda.cmi : \ middle_end/variable.cmi \ middle_end/flambda/base_types/tag.cmi \ - middle_end/symbol.cmi \ + utils/symbol.cmi \ middle_end/flambda/base_types/static_exception.cmi \ middle_end/flambda/base_types/set_of_closures_origin.cmi \ middle_end/flambda/base_types/set_of_closures_id.cmi \ @@ -4350,7 +4404,7 @@ middle_end/flambda/flambda_invariants.cmo : \ middle_end/variable.cmi \ middle_end/flambda/base_types/var_within_closure.cmi \ middle_end/flambda/base_types/tag.cmi \ - middle_end/symbol.cmi \ + utils/symbol.cmi \ middle_end/flambda/base_types/static_exception.cmi \ middle_end/flambda/base_types/set_of_closures_origin.cmi \ middle_end/flambda/base_types/set_of_closures_id.cmi \ @@ -4364,7 +4418,7 @@ middle_end/flambda/flambda_invariants.cmo : \ middle_end/flambda/flambda_iterators.cmi \ middle_end/flambda/flambda.cmi \ lambda/debuginfo.cmi \ - middle_end/compilation_unit.cmi \ + utils/compilation_unit.cmi \ middle_end/flambda/base_types/closure_id.cmi \ middle_end/clambda_primitives.cmi \ parsing/asttypes.cmi \ @@ -4374,7 +4428,7 @@ middle_end/flambda/flambda_invariants.cmx : \ middle_end/variable.cmx \ middle_end/flambda/base_types/var_within_closure.cmx \ middle_end/flambda/base_types/tag.cmx \ - middle_end/symbol.cmx \ + utils/symbol.cmx \ middle_end/flambda/base_types/static_exception.cmx \ middle_end/flambda/base_types/set_of_closures_origin.cmx \ middle_end/flambda/base_types/set_of_closures_id.cmx \ @@ -4388,7 +4442,7 @@ middle_end/flambda/flambda_invariants.cmx : \ middle_end/flambda/flambda_iterators.cmx \ middle_end/flambda/flambda.cmx \ lambda/debuginfo.cmx \ - middle_end/compilation_unit.cmx \ + utils/compilation_unit.cmx \ middle_end/flambda/base_types/closure_id.cmx \ middle_end/clambda_primitives.cmx \ parsing/asttypes.cmi \ @@ -4408,13 +4462,14 @@ middle_end/flambda/flambda_iterators.cmx : \ middle_end/flambda/flambda_iterators.cmi middle_end/flambda/flambda_iterators.cmi : \ middle_end/variable.cmi \ - middle_end/symbol.cmi \ + utils/symbol.cmi \ middle_end/flambda/flambda.cmi middle_end/flambda/flambda_middle_end.cmo : \ utils/warnings.cmi \ middle_end/variable.cmi \ middle_end/flambda/un_anf.cmi \ - middle_end/symbol.cmi \ + middle_end/symbol_utils.cmi \ + utils/symbol.cmi \ middle_end/flambda/share_constants.cmi \ middle_end/flambda/remove_unused_program_constructs.cmi \ middle_end/flambda/remove_unused_closure_vars.cmi \ @@ -4423,7 +4478,7 @@ middle_end/flambda/flambda_middle_end.cmo : \ middle_end/printclambda.cmi \ utils/misc.cmi \ parsing/location.cmi \ - middle_end/linkage_name.cmi \ + utils/linkage_name.cmi \ middle_end/flambda/lift_let_to_initialize_symbol.cmi \ middle_end/flambda/lift_constants.cmi \ middle_end/flambda/lift_code.cmi \ @@ -4443,13 +4498,13 @@ middle_end/flambda/flambda_middle_end.cmo : \ utils/clflags.cmi \ middle_end/clambda.cmi \ middle_end/flambda/build_export_info.cmi \ - middle_end/backend_intf.cmi \ middle_end/flambda/flambda_middle_end.cmi middle_end/flambda/flambda_middle_end.cmx : \ utils/warnings.cmx \ middle_end/variable.cmx \ middle_end/flambda/un_anf.cmx \ - middle_end/symbol.cmx \ + middle_end/symbol_utils.cmx \ + utils/symbol.cmx \ middle_end/flambda/share_constants.cmx \ middle_end/flambda/remove_unused_program_constructs.cmx \ middle_end/flambda/remove_unused_closure_vars.cmx \ @@ -4458,7 +4513,7 @@ middle_end/flambda/flambda_middle_end.cmx : \ middle_end/printclambda.cmx \ utils/misc.cmx \ parsing/location.cmx \ - middle_end/linkage_name.cmx \ + utils/linkage_name.cmx \ middle_end/flambda/lift_let_to_initialize_symbol.cmx \ middle_end/flambda/lift_constants.cmx \ middle_end/flambda/lift_code.cmx \ @@ -4478,7 +4533,6 @@ middle_end/flambda/flambda_middle_end.cmx : \ utils/clflags.cmx \ middle_end/clambda.cmx \ middle_end/flambda/build_export_info.cmx \ - middle_end/backend_intf.cmi \ middle_end/flambda/flambda_middle_end.cmi middle_end/flambda/flambda_middle_end.cmi : \ lambda/lambda.cmi \ @@ -4489,7 +4543,8 @@ middle_end/flambda/flambda_to_clambda.cmo : \ middle_end/flambda/base_types/var_within_closure.cmi \ middle_end/flambda/un_anf.cmi \ middle_end/flambda/base_types/tag.cmi \ - middle_end/symbol.cmi \ + middle_end/symbol_utils.cmi \ + utils/symbol.cmi \ middle_end/flambda/base_types/static_exception.cmi \ middle_end/flambda/simple_value_approx.cmi \ middle_end/flambda/base_types/set_of_closures_id.cmi \ @@ -4498,7 +4553,7 @@ middle_end/flambda/flambda_to_clambda.cmo : \ utils/numbers.cmi \ middle_end/flambda/base_types/mutable_variable.cmi \ utils/misc.cmi \ - middle_end/linkage_name.cmi \ + utils/linkage_name.cmi \ lambda/lambda.cmi \ middle_end/flambda/initialize_symbol_to_let_symbol.cmi \ middle_end/flambda/flambda_utils.cmi \ @@ -4506,7 +4561,7 @@ middle_end/flambda/flambda_to_clambda.cmo : \ middle_end/flambda/export_info.cmi \ lambda/debuginfo.cmi \ middle_end/compilenv.cmi \ - middle_end/compilation_unit.cmi \ + utils/compilation_unit.cmi \ middle_end/flambda/closure_offsets.cmi \ middle_end/flambda/base_types/closure_id.cmi \ utils/clflags.cmi \ @@ -4519,7 +4574,8 @@ middle_end/flambda/flambda_to_clambda.cmx : \ middle_end/flambda/base_types/var_within_closure.cmx \ middle_end/flambda/un_anf.cmx \ middle_end/flambda/base_types/tag.cmx \ - middle_end/symbol.cmx \ + middle_end/symbol_utils.cmx \ + utils/symbol.cmx \ middle_end/flambda/base_types/static_exception.cmx \ middle_end/flambda/simple_value_approx.cmx \ middle_end/flambda/base_types/set_of_closures_id.cmx \ @@ -4528,7 +4584,7 @@ middle_end/flambda/flambda_to_clambda.cmx : \ utils/numbers.cmx \ middle_end/flambda/base_types/mutable_variable.cmx \ utils/misc.cmx \ - middle_end/linkage_name.cmx \ + utils/linkage_name.cmx \ lambda/lambda.cmx \ middle_end/flambda/initialize_symbol_to_let_symbol.cmx \ middle_end/flambda/flambda_utils.cmx \ @@ -4536,7 +4592,7 @@ middle_end/flambda/flambda_to_clambda.cmx : \ middle_end/flambda/export_info.cmx \ lambda/debuginfo.cmx \ middle_end/compilenv.cmx \ - middle_end/compilation_unit.cmx \ + utils/compilation_unit.cmx \ middle_end/flambda/closure_offsets.cmx \ middle_end/flambda/base_types/closure_id.cmx \ utils/clflags.cmx \ @@ -4545,14 +4601,14 @@ middle_end/flambda/flambda_to_clambda.cmx : \ middle_end/flambda/allocated_const.cmx \ middle_end/flambda/flambda_to_clambda.cmi middle_end/flambda/flambda_to_clambda.cmi : \ - middle_end/symbol.cmi \ + utils/symbol.cmi \ middle_end/flambda/flambda.cmi \ middle_end/flambda/export_info.cmi \ middle_end/clambda.cmi middle_end/flambda/flambda_utils.cmo : \ middle_end/variable.cmi \ middle_end/flambda/base_types/var_within_closure.cmi \ - middle_end/symbol.cmi \ + utils/symbol.cmi \ lambda/switch.cmi \ middle_end/flambda/base_types/static_exception.cmi \ middle_end/flambda/base_types/set_of_closures_id.cmi \ @@ -4567,7 +4623,7 @@ middle_end/flambda/flambda_utils.cmo : \ middle_end/flambda/flambda_iterators.cmi \ middle_end/flambda/flambda.cmi \ lambda/debuginfo.cmi \ - middle_end/compilation_unit.cmi \ + utils/compilation_unit.cmi \ middle_end/flambda/base_types/closure_origin.cmi \ middle_end/flambda/base_types/closure_id.cmi \ middle_end/clambda_primitives.cmi \ @@ -4577,7 +4633,7 @@ middle_end/flambda/flambda_utils.cmo : \ middle_end/flambda/flambda_utils.cmx : \ middle_end/variable.cmx \ middle_end/flambda/base_types/var_within_closure.cmx \ - middle_end/symbol.cmx \ + utils/symbol.cmx \ lambda/switch.cmx \ middle_end/flambda/base_types/static_exception.cmx \ middle_end/flambda/base_types/set_of_closures_id.cmx \ @@ -4592,7 +4648,7 @@ middle_end/flambda/flambda_utils.cmx : \ middle_end/flambda/flambda_iterators.cmx \ middle_end/flambda/flambda.cmx \ lambda/debuginfo.cmx \ - middle_end/compilation_unit.cmx \ + utils/compilation_unit.cmx \ middle_end/flambda/base_types/closure_origin.cmx \ middle_end/flambda/base_types/closure_id.cmx \ middle_end/clambda_primitives.cmx \ @@ -4603,7 +4659,7 @@ middle_end/flambda/flambda_utils.cmi : \ middle_end/variable.cmi \ middle_end/flambda/base_types/var_within_closure.cmi \ middle_end/flambda/base_types/tag.cmi \ - middle_end/symbol.cmi \ + utils/symbol.cmi \ lambda/switch.cmi \ middle_end/flambda/base_types/static_exception.cmi \ middle_end/flambda/base_types/set_of_closures_id.cmi \ @@ -4616,7 +4672,8 @@ middle_end/flambda/flambda_utils.cmi : \ middle_end/flambda/freshening.cmo : \ middle_end/variable.cmi \ middle_end/flambda/base_types/var_within_closure.cmi \ - middle_end/symbol.cmi \ + middle_end/symbol_utils.cmi \ + utils/symbol.cmi \ middle_end/flambda/base_types/static_exception.cmi \ middle_end/flambda/projection.cmi \ middle_end/flambda/parameter.cmi \ @@ -4632,7 +4689,8 @@ middle_end/flambda/freshening.cmo : \ middle_end/flambda/freshening.cmx : \ middle_end/variable.cmx \ middle_end/flambda/base_types/var_within_closure.cmx \ - middle_end/symbol.cmx \ + middle_end/symbol_utils.cmx \ + utils/symbol.cmx \ middle_end/flambda/base_types/static_exception.cmx \ middle_end/flambda/projection.cmx \ middle_end/flambda/parameter.cmx \ @@ -4648,7 +4706,6 @@ middle_end/flambda/freshening.cmx : \ middle_end/flambda/freshening.cmi : \ middle_end/variable.cmi \ middle_end/flambda/base_types/var_within_closure.cmi \ - middle_end/symbol.cmi \ middle_end/flambda/base_types/static_exception.cmi \ middle_end/flambda/base_types/mutable_variable.cmi \ middle_end/flambda/flambda.cmi \ @@ -4656,7 +4713,8 @@ middle_end/flambda/freshening.cmi : \ middle_end/flambda/import_approx.cmo : \ middle_end/variable.cmi \ middle_end/flambda/base_types/var_within_closure.cmi \ - middle_end/symbol.cmi \ + middle_end/symbol_utils.cmi \ + utils/symbol.cmi \ middle_end/flambda/simple_value_approx.cmi \ middle_end/flambda/base_types/set_of_closures_id.cmi \ utils/misc.cmi \ @@ -4666,13 +4724,14 @@ middle_end/flambda/import_approx.cmo : \ middle_end/flambda/export_info.cmi \ middle_end/flambda/base_types/export_id.cmi \ middle_end/compilenv.cmi \ - middle_end/compilation_unit.cmi \ + utils/compilation_unit.cmi \ middle_end/flambda/base_types/closure_id.cmi \ middle_end/flambda/import_approx.cmi middle_end/flambda/import_approx.cmx : \ middle_end/variable.cmx \ middle_end/flambda/base_types/var_within_closure.cmx \ - middle_end/symbol.cmx \ + middle_end/symbol_utils.cmx \ + utils/symbol.cmx \ middle_end/flambda/simple_value_approx.cmx \ middle_end/flambda/base_types/set_of_closures_id.cmx \ utils/misc.cmx \ @@ -4682,15 +4741,15 @@ middle_end/flambda/import_approx.cmx : \ middle_end/flambda/export_info.cmx \ middle_end/flambda/base_types/export_id.cmx \ middle_end/compilenv.cmx \ - middle_end/compilation_unit.cmx \ + utils/compilation_unit.cmx \ middle_end/flambda/base_types/closure_id.cmx \ middle_end/flambda/import_approx.cmi middle_end/flambda/import_approx.cmi : \ - middle_end/symbol.cmi \ + utils/symbol.cmi \ middle_end/flambda/simple_value_approx.cmi middle_end/flambda/inconstant_idents.cmo : \ middle_end/variable.cmi \ - middle_end/symbol.cmi \ + utils/symbol.cmi \ middle_end/flambda/base_types/set_of_closures_id.cmi \ middle_end/flambda/parameter.cmi \ utils/numbers.cmi \ @@ -4698,13 +4757,13 @@ middle_end/flambda/inconstant_idents.cmo : \ utils/identifiable.cmi \ middle_end/flambda/flambda_utils.cmi \ middle_end/flambda/flambda.cmi \ - middle_end/compilation_unit.cmi \ + utils/compilation_unit.cmi \ middle_end/flambda/base_types/closure_id.cmi \ middle_end/backend_intf.cmi \ middle_end/flambda/inconstant_idents.cmi middle_end/flambda/inconstant_idents.cmx : \ middle_end/variable.cmx \ - middle_end/symbol.cmx \ + utils/symbol.cmx \ middle_end/flambda/base_types/set_of_closures_id.cmx \ middle_end/flambda/parameter.cmx \ utils/numbers.cmx \ @@ -4712,7 +4771,7 @@ middle_end/flambda/inconstant_idents.cmx : \ utils/identifiable.cmx \ middle_end/flambda/flambda_utils.cmx \ middle_end/flambda/flambda.cmx \ - middle_end/compilation_unit.cmx \ + utils/compilation_unit.cmx \ middle_end/flambda/base_types/closure_id.cmx \ middle_end/backend_intf.cmi \ middle_end/flambda/inconstant_idents.cmi @@ -4720,7 +4779,7 @@ middle_end/flambda/inconstant_idents.cmi : \ middle_end/variable.cmi \ middle_end/flambda/base_types/set_of_closures_id.cmi \ middle_end/flambda/flambda.cmi \ - middle_end/compilation_unit.cmi \ + utils/compilation_unit.cmi \ middle_end/backend_intf.cmi middle_end/flambda/initialize_symbol_to_let_symbol.cmo : \ middle_end/variable.cmi \ @@ -4744,7 +4803,7 @@ middle_end/flambda/inline_and_simplify.cmo : \ middle_end/flambda/unbox_free_vars_of_closures.cmi \ middle_end/flambda/unbox_closures.cmi \ middle_end/flambda/base_types/tag.cmi \ - middle_end/symbol.cmi \ + utils/symbol.cmi \ middle_end/flambda/base_types/static_exception.cmi \ middle_end/flambda/simplify_primitives.cmi \ middle_end/flambda/simple_value_approx.cmi \ @@ -4788,7 +4847,7 @@ middle_end/flambda/inline_and_simplify.cmx : \ middle_end/flambda/unbox_free_vars_of_closures.cmx \ middle_end/flambda/unbox_closures.cmx \ middle_end/flambda/base_types/tag.cmx \ - middle_end/symbol.cmx \ + utils/symbol.cmx \ middle_end/flambda/base_types/static_exception.cmx \ middle_end/flambda/simplify_primitives.cmx \ middle_end/flambda/simple_value_approx.cmx \ @@ -4832,7 +4891,7 @@ middle_end/flambda/inline_and_simplify.cmi : \ middle_end/flambda/inline_and_simplify_aux.cmo : \ middle_end/variable.cmi \ middle_end/flambda/base_types/var_within_closure.cmi \ - middle_end/symbol.cmi \ + utils/symbol.cmi \ middle_end/flambda/base_types/static_exception.cmi \ middle_end/flambda/simple_value_approx.cmi \ middle_end/flambda/base_types/set_of_closures_origin.cmi \ @@ -4847,7 +4906,7 @@ middle_end/flambda/inline_and_simplify_aux.cmo : \ middle_end/flambda/flambda_utils.cmi \ middle_end/flambda/flambda.cmi \ lambda/debuginfo.cmi \ - middle_end/compilation_unit.cmi \ + utils/compilation_unit.cmi \ middle_end/flambda/base_types/closure_origin.cmi \ middle_end/flambda/base_types/closure_id.cmi \ utils/clflags.cmi \ @@ -4856,7 +4915,7 @@ middle_end/flambda/inline_and_simplify_aux.cmo : \ middle_end/flambda/inline_and_simplify_aux.cmx : \ middle_end/variable.cmx \ middle_end/flambda/base_types/var_within_closure.cmx \ - middle_end/symbol.cmx \ + utils/symbol.cmx \ middle_end/flambda/base_types/static_exception.cmx \ middle_end/flambda/simple_value_approx.cmx \ middle_end/flambda/base_types/set_of_closures_origin.cmx \ @@ -4871,7 +4930,7 @@ middle_end/flambda/inline_and_simplify_aux.cmx : \ middle_end/flambda/flambda_utils.cmx \ middle_end/flambda/flambda.cmx \ lambda/debuginfo.cmx \ - middle_end/compilation_unit.cmx \ + utils/compilation_unit.cmx \ middle_end/flambda/base_types/closure_origin.cmx \ middle_end/flambda/base_types/closure_id.cmx \ utils/clflags.cmx \ @@ -4879,7 +4938,7 @@ middle_end/flambda/inline_and_simplify_aux.cmx : \ middle_end/flambda/inline_and_simplify_aux.cmi middle_end/flambda/inline_and_simplify_aux.cmi : \ middle_end/variable.cmi \ - middle_end/symbol.cmi \ + utils/symbol.cmi \ middle_end/flambda/base_types/static_exception.cmi \ middle_end/flambda/simple_value_approx.cmi \ middle_end/flambda/base_types/set_of_closures_origin.cmi \ @@ -5012,7 +5071,7 @@ middle_end/flambda/inlining_transforms.cmo : \ middle_end/flambda/flambda_iterators.cmi \ middle_end/flambda/flambda.cmi \ lambda/debuginfo.cmi \ - middle_end/compilation_unit.cmi \ + utils/compilation_unit.cmi \ middle_end/flambda/base_types/closure_origin.cmi \ middle_end/flambda/base_types/closure_id.cmi \ middle_end/flambda/inlining_transforms.cmi @@ -5032,7 +5091,7 @@ middle_end/flambda/inlining_transforms.cmx : \ middle_end/flambda/flambda_iterators.cmx \ middle_end/flambda/flambda.cmx \ lambda/debuginfo.cmx \ - middle_end/compilation_unit.cmx \ + utils/compilation_unit.cmx \ middle_end/flambda/base_types/closure_origin.cmx \ middle_end/flambda/base_types/closure_id.cmx \ middle_end/flambda/inlining_transforms.cmi @@ -5047,7 +5106,8 @@ middle_end/flambda/inlining_transforms.cmi : \ middle_end/flambda/base_types/closure_id.cmi middle_end/flambda/invariant_params.cmo : \ middle_end/variable.cmi \ - middle_end/symbol.cmi \ + middle_end/symbol_utils.cmi \ + utils/symbol.cmi \ middle_end/flambda/parameter.cmi \ utils/int_replace_polymorphic_compare.cmi \ middle_end/flambda/flambda_utils.cmi \ @@ -5055,11 +5115,11 @@ middle_end/flambda/invariant_params.cmo : \ middle_end/flambda/flambda.cmi \ middle_end/flambda/base_types/closure_id.cmi \ utils/clflags.cmi \ - middle_end/backend_intf.cmi \ middle_end/flambda/invariant_params.cmi middle_end/flambda/invariant_params.cmx : \ middle_end/variable.cmx \ - middle_end/symbol.cmx \ + middle_end/symbol_utils.cmx \ + utils/symbol.cmx \ middle_end/flambda/parameter.cmx \ utils/int_replace_polymorphic_compare.cmx \ middle_end/flambda/flambda_utils.cmx \ @@ -5067,12 +5127,10 @@ middle_end/flambda/invariant_params.cmx : \ middle_end/flambda/flambda.cmx \ middle_end/flambda/base_types/closure_id.cmx \ utils/clflags.cmx \ - middle_end/backend_intf.cmi \ middle_end/flambda/invariant_params.cmi middle_end/flambda/invariant_params.cmi : \ middle_end/variable.cmi \ - middle_end/flambda/flambda.cmi \ - middle_end/backend_intf.cmi + middle_end/flambda/flambda.cmi middle_end/flambda/lift_code.cmo : \ middle_end/variable.cmi \ utils/strongly_connected_components.cmi \ @@ -5081,7 +5139,7 @@ middle_end/flambda/lift_code.cmo : \ utils/int_replace_polymorphic_compare.cmi \ middle_end/flambda/flambda_iterators.cmi \ middle_end/flambda/flambda.cmi \ - middle_end/compilation_unit.cmi \ + utils/compilation_unit.cmi \ middle_end/flambda/lift_code.cmi middle_end/flambda/lift_code.cmx : \ middle_end/variable.cmx \ @@ -5091,7 +5149,7 @@ middle_end/flambda/lift_code.cmx : \ utils/int_replace_polymorphic_compare.cmx \ middle_end/flambda/flambda_iterators.cmx \ middle_end/flambda/flambda.cmx \ - middle_end/compilation_unit.cmx \ + utils/compilation_unit.cmx \ middle_end/flambda/lift_code.cmi middle_end/flambda/lift_code.cmi : \ middle_end/variable.cmi \ @@ -5101,7 +5159,8 @@ middle_end/flambda/lift_constants.cmo : \ middle_end/variable.cmi \ middle_end/flambda/base_types/var_within_closure.cmi \ middle_end/flambda/base_types/tag.cmi \ - middle_end/symbol.cmi \ + middle_end/symbol_utils.cmi \ + utils/symbol.cmi \ utils/strongly_connected_components.cmi \ middle_end/flambda/simple_value_approx.cmi \ utils/misc.cmi \ @@ -5112,7 +5171,7 @@ middle_end/flambda/lift_constants.cmo : \ middle_end/flambda/flambda_utils.cmi \ middle_end/flambda/flambda_iterators.cmi \ middle_end/flambda/flambda.cmi \ - middle_end/compilation_unit.cmi \ + utils/compilation_unit.cmi \ middle_end/flambda/base_types/closure_id.cmi \ middle_end/backend_intf.cmi \ middle_end/flambda/allocated_const.cmi \ @@ -5122,7 +5181,8 @@ middle_end/flambda/lift_constants.cmx : \ middle_end/variable.cmx \ middle_end/flambda/base_types/var_within_closure.cmx \ middle_end/flambda/base_types/tag.cmx \ - middle_end/symbol.cmx \ + middle_end/symbol_utils.cmx \ + utils/symbol.cmx \ utils/strongly_connected_components.cmx \ middle_end/flambda/simple_value_approx.cmx \ utils/misc.cmx \ @@ -5133,7 +5193,7 @@ middle_end/flambda/lift_constants.cmx : \ middle_end/flambda/flambda_utils.cmx \ middle_end/flambda/flambda_iterators.cmx \ middle_end/flambda/flambda.cmx \ - middle_end/compilation_unit.cmx \ + utils/compilation_unit.cmx \ middle_end/flambda/base_types/closure_id.cmx \ middle_end/backend_intf.cmi \ middle_end/flambda/allocated_const.cmx \ @@ -5145,7 +5205,8 @@ middle_end/flambda/lift_constants.cmi : \ middle_end/flambda/lift_let_to_initialize_symbol.cmo : \ middle_end/variable.cmi \ middle_end/flambda/base_types/tag.cmi \ - middle_end/symbol.cmi \ + middle_end/symbol_utils.cmi \ + utils/symbol.cmi \ lambda/lambda.cmi \ middle_end/internal_variable_names.cmi \ utils/int_replace_polymorphic_compare.cmi \ @@ -5156,7 +5217,8 @@ middle_end/flambda/lift_let_to_initialize_symbol.cmo : \ middle_end/flambda/lift_let_to_initialize_symbol.cmx : \ middle_end/variable.cmx \ middle_end/flambda/base_types/tag.cmx \ - middle_end/symbol.cmx \ + middle_end/symbol_utils.cmx \ + utils/symbol.cmx \ lambda/lambda.cmx \ middle_end/internal_variable_names.cmx \ utils/int_replace_polymorphic_compare.cmx \ @@ -5183,7 +5245,7 @@ middle_end/flambda/parameter.cmi : \ middle_end/variable.cmi \ lambda/lambda.cmi \ utils/identifiable.cmi \ - middle_end/compilation_unit.cmi + utils/compilation_unit.cmi middle_end/flambda/pass_wrapper.cmo : \ utils/int_replace_polymorphic_compare.cmi \ utils/clflags.cmi \ @@ -5261,7 +5323,7 @@ middle_end/flambda/remove_unused_arguments.cmo : \ middle_end/flambda/flambda_iterators.cmi \ middle_end/flambda/flambda.cmi \ middle_end/flambda/find_recursive_functions.cmi \ - middle_end/compilation_unit.cmi \ + utils/compilation_unit.cmi \ middle_end/flambda/base_types/closure_origin.cmi \ middle_end/flambda/base_types/closure_id.cmi \ utils/clflags.cmi \ @@ -5277,14 +5339,13 @@ middle_end/flambda/remove_unused_arguments.cmx : \ middle_end/flambda/flambda_iterators.cmx \ middle_end/flambda/flambda.cmx \ middle_end/flambda/find_recursive_functions.cmx \ - middle_end/compilation_unit.cmx \ + utils/compilation_unit.cmx \ middle_end/flambda/base_types/closure_origin.cmx \ middle_end/flambda/base_types/closure_id.cmx \ utils/clflags.cmx \ middle_end/flambda/remove_unused_arguments.cmi middle_end/flambda/remove_unused_arguments.cmi : \ - middle_end/flambda/flambda.cmi \ - middle_end/backend_intf.cmi + middle_end/flambda/flambda.cmi middle_end/flambda/remove_unused_closure_vars.cmo : \ middle_end/variable.cmi \ middle_end/flambda/base_types/var_within_closure.cmi \ @@ -5308,13 +5369,13 @@ middle_end/flambda/remove_unused_closure_vars.cmx : \ middle_end/flambda/remove_unused_closure_vars.cmi : \ middle_end/flambda/flambda.cmi middle_end/flambda/remove_unused_program_constructs.cmo : \ - middle_end/symbol.cmi \ + utils/symbol.cmi \ utils/int_replace_polymorphic_compare.cmi \ middle_end/flambda/flambda.cmi \ middle_end/flambda/effect_analysis.cmi \ middle_end/flambda/remove_unused_program_constructs.cmi middle_end/flambda/remove_unused_program_constructs.cmx : \ - middle_end/symbol.cmx \ + utils/symbol.cmx \ utils/int_replace_polymorphic_compare.cmx \ middle_end/flambda/flambda.cmx \ middle_end/flambda/effect_analysis.cmx \ @@ -5322,13 +5383,13 @@ middle_end/flambda/remove_unused_program_constructs.cmx : \ middle_end/flambda/remove_unused_program_constructs.cmi : \ middle_end/flambda/flambda.cmi middle_end/flambda/share_constants.cmo : \ - middle_end/symbol.cmi \ + utils/symbol.cmi \ utils/int_replace_polymorphic_compare.cmi \ middle_end/flambda/flambda_iterators.cmi \ middle_end/flambda/flambda.cmi \ middle_end/flambda/share_constants.cmi middle_end/flambda/share_constants.cmx : \ - middle_end/symbol.cmx \ + utils/symbol.cmx \ utils/int_replace_polymorphic_compare.cmx \ middle_end/flambda/flambda_iterators.cmx \ middle_end/flambda/flambda.cmx \ @@ -5339,7 +5400,7 @@ middle_end/flambda/simple_value_approx.cmo : \ middle_end/variable.cmi \ middle_end/flambda/base_types/var_within_closure.cmi \ middle_end/flambda/base_types/tag.cmi \ - middle_end/symbol.cmi \ + utils/symbol.cmi \ middle_end/flambda/base_types/set_of_closures_origin.cmi \ middle_end/flambda/base_types/set_of_closures_id.cmi \ middle_end/flambda/parameter.cmi \ @@ -5354,7 +5415,7 @@ middle_end/flambda/simple_value_approx.cmo : \ middle_end/flambda/base_types/export_id.cmi \ middle_end/flambda/effect_analysis.cmi \ lambda/debuginfo.cmi \ - middle_end/compilation_unit.cmi \ + utils/compilation_unit.cmi \ middle_end/flambda/base_types/closure_origin.cmi \ middle_end/flambda/base_types/closure_id.cmi \ middle_end/flambda/allocated_const.cmi \ @@ -5363,7 +5424,7 @@ middle_end/flambda/simple_value_approx.cmx : \ middle_end/variable.cmx \ middle_end/flambda/base_types/var_within_closure.cmx \ middle_end/flambda/base_types/tag.cmx \ - middle_end/symbol.cmx \ + utils/symbol.cmx \ middle_end/flambda/base_types/set_of_closures_origin.cmx \ middle_end/flambda/base_types/set_of_closures_id.cmx \ middle_end/flambda/parameter.cmx \ @@ -5378,7 +5439,7 @@ middle_end/flambda/simple_value_approx.cmx : \ middle_end/flambda/base_types/export_id.cmx \ middle_end/flambda/effect_analysis.cmx \ lambda/debuginfo.cmx \ - middle_end/compilation_unit.cmx \ + utils/compilation_unit.cmx \ middle_end/flambda/base_types/closure_origin.cmx \ middle_end/flambda/base_types/closure_id.cmx \ middle_end/flambda/allocated_const.cmx \ @@ -5387,7 +5448,7 @@ middle_end/flambda/simple_value_approx.cmi : \ middle_end/variable.cmi \ middle_end/flambda/base_types/var_within_closure.cmi \ middle_end/flambda/base_types/tag.cmi \ - middle_end/symbol.cmi \ + utils/symbol.cmi \ middle_end/flambda/base_types/set_of_closures_origin.cmi \ middle_end/flambda/base_types/set_of_closures_id.cmi \ middle_end/flambda/parameter.cmi \ @@ -5444,7 +5505,7 @@ middle_end/flambda/simplify_common.cmi : \ middle_end/flambda/flambda.cmi middle_end/flambda/simplify_primitives.cmo : \ middle_end/flambda/base_types/tag.cmi \ - middle_end/symbol.cmi \ + utils/symbol.cmi \ middle_end/flambda/simplify_common.cmi \ middle_end/flambda/simplify_boxed_integer_ops.cmi \ middle_end/flambda/simple_value_approx.cmi \ @@ -5459,7 +5520,7 @@ middle_end/flambda/simplify_primitives.cmo : \ middle_end/flambda/simplify_primitives.cmi middle_end/flambda/simplify_primitives.cmx : \ middle_end/flambda/base_types/tag.cmx \ - middle_end/symbol.cmx \ + utils/symbol.cmx \ middle_end/flambda/simplify_common.cmx \ middle_end/flambda/simplify_boxed_integer_ops.cmx \ middle_end/flambda/simple_value_approx.cmx \ @@ -5482,7 +5543,7 @@ middle_end/flambda/simplify_primitives.cmi : \ middle_end/flambda/traverse_for_exported_symbols.cmo : \ middle_end/variable.cmi \ middle_end/flambda/base_types/var_within_closure.cmi \ - middle_end/symbol.cmi \ + utils/symbol.cmi \ middle_end/flambda/simple_value_approx.cmi \ middle_end/flambda/base_types/set_of_closures_id.cmi \ utils/misc.cmi \ @@ -5490,13 +5551,13 @@ middle_end/flambda/traverse_for_exported_symbols.cmo : \ middle_end/flambda/flambda.cmi \ middle_end/flambda/export_info.cmi \ middle_end/flambda/base_types/export_id.cmi \ - middle_end/compilation_unit.cmi \ + utils/compilation_unit.cmi \ middle_end/flambda/base_types/closure_id.cmi \ middle_end/flambda/traverse_for_exported_symbols.cmi middle_end/flambda/traverse_for_exported_symbols.cmx : \ middle_end/variable.cmx \ middle_end/flambda/base_types/var_within_closure.cmx \ - middle_end/symbol.cmx \ + utils/symbol.cmx \ middle_end/flambda/simple_value_approx.cmx \ middle_end/flambda/base_types/set_of_closures_id.cmx \ utils/misc.cmx \ @@ -5504,12 +5565,12 @@ middle_end/flambda/traverse_for_exported_symbols.cmx : \ middle_end/flambda/flambda.cmx \ middle_end/flambda/export_info.cmx \ middle_end/flambda/base_types/export_id.cmx \ - middle_end/compilation_unit.cmx \ + utils/compilation_unit.cmx \ middle_end/flambda/base_types/closure_id.cmx \ middle_end/flambda/traverse_for_exported_symbols.cmi middle_end/flambda/traverse_for_exported_symbols.cmi : \ middle_end/flambda/base_types/var_within_closure.cmi \ - middle_end/symbol.cmi \ + utils/symbol.cmi \ middle_end/flambda/simple_value_approx.cmi \ middle_end/flambda/base_types/set_of_closures_id.cmi \ middle_end/flambda/flambda.cmi \ @@ -5517,7 +5578,7 @@ middle_end/flambda/traverse_for_exported_symbols.cmi : \ middle_end/flambda/base_types/export_id.cmi \ middle_end/flambda/base_types/closure_id.cmi middle_end/flambda/un_anf.cmo : \ - middle_end/symbol.cmi \ + utils/symbol.cmi \ middle_end/semantics_of_primitives.cmi \ middle_end/printclambda.cmi \ utils/misc.cmi \ @@ -5530,7 +5591,7 @@ middle_end/flambda/un_anf.cmo : \ parsing/asttypes.cmi \ middle_end/flambda/un_anf.cmi middle_end/flambda/un_anf.cmx : \ - middle_end/symbol.cmx \ + utils/symbol.cmx \ middle_end/semantics_of_primitives.cmx \ middle_end/printclambda.cmx \ utils/misc.cmx \ @@ -5543,7 +5604,7 @@ middle_end/flambda/un_anf.cmx : \ parsing/asttypes.cmi \ middle_end/flambda/un_anf.cmi middle_end/flambda/un_anf.cmi : \ - middle_end/symbol.cmi \ + utils/symbol.cmi \ middle_end/clambda.cmi middle_end/flambda/unbox_closures.cmo : \ middle_end/variable.cmi \ @@ -5613,7 +5674,6 @@ middle_end/flambda/unbox_specialised_args.cmo : \ middle_end/flambda/projection.cmi \ middle_end/flambda/invariant_params.cmi \ utils/int_replace_polymorphic_compare.cmi \ - middle_end/flambda/inline_and_simplify_aux.cmi \ middle_end/flambda/flambda.cmi \ middle_end/flambda/extract_projections.cmi \ utils/clflags.cmi \ @@ -5624,7 +5684,6 @@ middle_end/flambda/unbox_specialised_args.cmx : \ middle_end/flambda/projection.cmx \ middle_end/flambda/invariant_params.cmx \ utils/int_replace_polymorphic_compare.cmx \ - middle_end/flambda/inline_and_simplify_aux.cmx \ middle_end/flambda/flambda.cmx \ middle_end/flambda/extract_projections.cmx \ utils/clflags.cmx \ @@ -5646,7 +5705,7 @@ middle_end/flambda/base_types/closure_element.cmx : \ middle_end/flambda/base_types/closure_element.cmi : \ middle_end/variable.cmi \ utils/identifiable.cmi \ - middle_end/compilation_unit.cmi + utils/compilation_unit.cmi middle_end/flambda/base_types/closure_id.cmo : \ utils/int_replace_polymorphic_compare.cmi \ middle_end/flambda/base_types/closure_element.cmi \ @@ -5667,23 +5726,23 @@ middle_end/flambda/base_types/closure_origin.cmx : \ middle_end/flambda/base_types/closure_origin.cmi middle_end/flambda/base_types/closure_origin.cmi : \ utils/identifiable.cmi \ - middle_end/compilation_unit.cmi \ + utils/compilation_unit.cmi \ middle_end/flambda/base_types/closure_id.cmi middle_end/flambda/base_types/export_id.cmo : \ utils/int_replace_polymorphic_compare.cmi \ utils/identifiable.cmi \ middle_end/flambda/base_types/id_types.cmi \ - middle_end/compilation_unit.cmi \ + utils/compilation_unit.cmi \ middle_end/flambda/base_types/export_id.cmi middle_end/flambda/base_types/export_id.cmx : \ utils/int_replace_polymorphic_compare.cmx \ utils/identifiable.cmx \ middle_end/flambda/base_types/id_types.cmx \ - middle_end/compilation_unit.cmx \ + utils/compilation_unit.cmx \ middle_end/flambda/base_types/export_id.cmi middle_end/flambda/base_types/export_id.cmi : \ utils/identifiable.cmi \ - middle_end/compilation_unit.cmi + utils/compilation_unit.cmi middle_end/flambda/base_types/id_types.cmo : \ utils/int_replace_polymorphic_compare.cmi \ utils/identifiable.cmi \ @@ -5707,22 +5766,22 @@ middle_end/flambda/base_types/mutable_variable.cmi : \ middle_end/internal_variable_names.cmi \ utils/identifiable.cmi \ typing/ident.cmi \ - middle_end/compilation_unit.cmi + utils/compilation_unit.cmi middle_end/flambda/base_types/set_of_closures_id.cmo : \ utils/int_replace_polymorphic_compare.cmi \ utils/identifiable.cmi \ middle_end/flambda/base_types/id_types.cmi \ - middle_end/compilation_unit.cmi \ + utils/compilation_unit.cmi \ middle_end/flambda/base_types/set_of_closures_id.cmi middle_end/flambda/base_types/set_of_closures_id.cmx : \ utils/int_replace_polymorphic_compare.cmx \ utils/identifiable.cmx \ middle_end/flambda/base_types/id_types.cmx \ - middle_end/compilation_unit.cmx \ + utils/compilation_unit.cmx \ middle_end/flambda/base_types/set_of_closures_id.cmi middle_end/flambda/base_types/set_of_closures_id.cmi : \ utils/identifiable.cmi \ - middle_end/compilation_unit.cmi + utils/compilation_unit.cmi middle_end/flambda/base_types/set_of_closures_origin.cmo : \ middle_end/flambda/base_types/set_of_closures_id.cmi \ utils/int_replace_polymorphic_compare.cmi \ @@ -5734,7 +5793,7 @@ middle_end/flambda/base_types/set_of_closures_origin.cmx : \ middle_end/flambda/base_types/set_of_closures_origin.cmi : \ middle_end/flambda/base_types/set_of_closures_id.cmi \ utils/identifiable.cmi \ - middle_end/compilation_unit.cmi + utils/compilation_unit.cmi middle_end/flambda/base_types/static_exception.cmo : \ utils/numbers.cmi \ lambda/lambda.cmi \ @@ -6067,6 +6126,7 @@ driver/optcompile.cmo : \ utils/config.cmi \ middle_end/compilenv.cmi \ driver/compile_common.cmi \ + utils/compilation_unit.cmi \ middle_end/closure/closure_middle_end.cmi \ utils/clflags.cmi \ asmcomp/asmgen.cmi \ @@ -6082,6 +6142,7 @@ driver/optcompile.cmx : \ utils/config.cmx \ middle_end/compilenv.cmx \ driver/compile_common.cmx \ + utils/compilation_unit.cmx \ middle_end/closure/closure_middle_end.cmx \ utils/clflags.cmx \ asmcomp/asmgen.cmx \ @@ -6294,6 +6355,7 @@ toplevel/opttoploop.cmo : \ utils/config.cmi \ driver/compmisc.cmi \ middle_end/compilenv.cmi \ + utils/compilation_unit.cmi \ driver/compenv.cmi \ middle_end/closure/closure_middle_end.cmi \ utils/clflags.cmi \ @@ -6341,6 +6403,7 @@ toplevel/opttoploop.cmx : \ utils/config.cmx \ driver/compmisc.cmx \ middle_end/compilenv.cmx \ + utils/compilation_unit.cmx \ driver/compenv.cmx \ middle_end/closure/closure_middle_end.cmx \ utils/clflags.cmx \ diff --git a/asmcomp/amd64/emit.mlp b/asmcomp/amd64/emit.mlp index e55a7399014..4670858aee7 100644 --- a/asmcomp/amd64/emit.mlp +++ b/asmcomp/amd64/emit.mlp @@ -481,7 +481,7 @@ let emit_float_constant f lbl = D.qword (Const f) let emit_global_label s = - let lbl = Compilenv.make_symbol (Some s) in + let lbl = Cmm_helpers.make_symbol s in add_def_symbol lbl; let lbl = emit_symbol lbl in D.global lbl; @@ -556,7 +556,7 @@ type probe = let probe_handler_wrapper_name probe_label = let w = Printf.sprintf "probe_wrapper_%d" probe_label in - Compilenv.make_symbol (Some w) + Cmm_helpers.make_symbol w |> emit_symbol let probes = ref [] @@ -571,7 +571,7 @@ let find_or_add_semaphore name = match String.Map.find_opt name !probe_semaphores with | Some label -> label | None -> - let sym = Compilenv.make_symbol (Some ("semaphore_"^name)) in + let sym = Cmm_helpers.make_symbol ("semaphore_"^name) in probe_semaphores := String.Map.add name sym !probe_semaphores; sym @@ -1162,7 +1162,7 @@ let begin_assembly() = D.data (); emit_global_label "data_begin"; - emit_named_text_section (Compilenv.make_symbol (Some "code_begin")); + emit_named_text_section (Cmm_helpers.make_symbol "code_begin"); emit_global_label "code_begin"; if system = S_macosx then I.nop (); (* PR#4690 *) () @@ -1438,7 +1438,7 @@ let end_assembly() = (* Emit probe handler wrappers *) List.iter emit_probe_handler_wrapper !probes; - emit_named_text_section (Compilenv.make_symbol (Some "code_end")); + emit_named_text_section (Cmm_helpers.make_symbol "code_end"); if system = S_macosx then I.nop (); (* suppress "ld warning: atom sorting error" *) @@ -1483,7 +1483,7 @@ let end_assembly() = }; if system = S_linux then begin - let frametable = emit_symbol (Compilenv.make_symbol (Some "frametable")) in + let frametable = emit_symbol (Cmm_helpers.make_symbol "frametable") in D.size frametable (ConstSub (ConstThis, ConstLabel frametable)) end; diff --git a/asmcomp/arm/emit.mlp b/asmcomp/arm/emit.mlp index 220b679c6b2..077ef78671a 100644 --- a/asmcomp/arm/emit.mlp +++ b/asmcomp/arm/emit.mlp @@ -1041,27 +1041,27 @@ let begin_assembly() = `trap_ptr .req r8\n`; `alloc_ptr .req r10\n`; `domain_state_ptr .req r11\n`; - let lbl_begin = Compilenv.make_symbol (Some "data_begin") in + let lbl_begin = Cmm_helpers.make_symbol "data_begin" in ` .data\n`; ` .globl {emit_symbol lbl_begin}\n`; `{emit_symbol lbl_begin}:\n`; - let lbl_begin = Compilenv.make_symbol (Some "code_begin") in + let lbl_begin = Cmm_helpers.make_symbol "code_begin" in emit_named_text_section lbl_begin; ` .globl {emit_symbol lbl_begin}\n`; `{emit_symbol lbl_begin}:\n` let end_assembly () = - let lbl_end = Compilenv.make_symbol (Some "code_end") in + let lbl_end = Cmm_helpers.make_symbol "code_end" in emit_named_text_section lbl_end; ` .globl {emit_symbol lbl_end}\n`; `{emit_symbol lbl_end}:\n`; - let lbl_end = Compilenv.make_symbol (Some "data_end") in + let lbl_end = Cmm_helpers.make_symbol "data_end" in ` .data\n`; ` .long 0\n`; (* PR#6329 *) ` .globl {emit_symbol lbl_end}\n`; `{emit_symbol lbl_end}:\n`; ` .long 0\n`; - let lbl = Compilenv.make_symbol (Some "frametable") in + let lbl = Cmm_helpers.make_symbol "frametable" in ` .globl {emit_symbol lbl}\n`; `{emit_symbol lbl}:\n`; emit_frames diff --git a/asmcomp/arm64/emit.mlp b/asmcomp/arm64/emit.mlp index f275bc67c9c..5bed83d5d2d 100644 --- a/asmcomp/arm64/emit.mlp +++ b/asmcomp/arm64/emit.mlp @@ -1082,28 +1082,28 @@ let data l = let begin_assembly() = reset_debug_info(); ` .file \"\"\n`; (* PR#7037 *) - let lbl_begin = Compilenv.make_symbol (Some "data_begin") in + let lbl_begin = Cmm_helpers.make_symbol "data_begin" in ` .data\n`; ` .globl {emit_symbol lbl_begin}\n`; `{emit_symbol lbl_begin}:\n`; - let lbl_begin = Compilenv.make_symbol (Some "code_begin") in + let lbl_begin = Cmm_helpers.make_symbol "code_begin" in emit_named_text_section lbl_begin; ` .globl {emit_symbol lbl_begin}\n`; `{emit_symbol lbl_begin}:\n` let end_assembly () = - let lbl_end = Compilenv.make_symbol (Some "code_end") in + let lbl_end = Cmm_helpers.make_symbol "code_end" in emit_named_text_section lbl_end; ` .globl {emit_symbol lbl_end}\n`; `{emit_symbol lbl_end}:\n`; - let lbl_end = Compilenv.make_symbol (Some "data_end") in + let lbl_end = Cmm_helpers.make_symbol "data_end" in ` .data\n`; ` .quad 0\n`; (* PR#6329 *) ` .globl {emit_symbol lbl_end}\n`; `{emit_symbol lbl_end}:\n`; ` .quad 0\n`; ` .align 3\n`; (* #7887 *) - let lbl = Compilenv.make_symbol (Some "frametable") in + let lbl = Cmm_helpers.make_symbol "frametable" in ` .globl {emit_symbol lbl}\n`; `{emit_symbol lbl}:\n`; emit_frames diff --git a/asmcomp/asmgen.ml b/asmcomp/asmgen.ml index bab9aab5010..f8073b47f7f 100644 --- a/asmcomp/asmgen.ml +++ b/asmcomp/asmgen.ml @@ -25,7 +25,7 @@ open Cmm type error = | Assembler_error of string - | Mismatched_for_pack of string option + | Mismatched_for_pack of Compilation_unit.Prefix.t | Asm_generation of string * Emitaux.error exception Error of error @@ -58,17 +58,15 @@ let should_save_before_emit () = should_save_ir_after Compiler_pass.Scheduling && (not !start_from_emit) let linear_unit_info = - { Linear_format.unit_name = ""; + { Linear_format.unit = Compilation_unit.dummy; items = []; - for_pack = None; } let reset () = start_from_emit := false; if should_save_before_emit () then begin - linear_unit_info.unit_name <- Compilenv.current_unit_name (); + linear_unit_info.unit <- Compilation_unit.get_current_exn (); linear_unit_info.items <- []; - linear_unit_info.for_pack <- !Clflags.for_package; end let save_data dl = @@ -261,10 +259,11 @@ let compile_implementation ?toplevel ~backend ~filename ~prefixname ~middle_end let linear_gen_implementation filename = let open Linear_format in let linear_unit_info, _ = restore filename in - (match !Clflags.for_package, linear_unit_info.for_pack with - | None, None -> () - | Some expected, Some saved when String.equal expected saved -> () - | _, saved -> raise(Error(Mismatched_for_pack saved))); + let current_package = Compilation_unit.Prefix.from_clflags () in + let saved_package = + Compilation_unit.for_pack_prefix linear_unit_info.unit in + if not (Compilation_unit.Prefix.equal current_package saved_package) + then raise(Error(Mismatched_for_pack saved_package)); let emit_item = function | Data dl -> emit_data dl | Func f -> emit_fundecl f @@ -288,13 +287,15 @@ let report_error ppf = function fprintf ppf "Assembler error, input left in file %a" Location.print_filename file | Mismatched_for_pack saved -> - let msg = function - | None -> "without -for-pack" - | Some s -> "with -for-pack "^s + let msg prefix = + if Compilation_unit.Prefix.is_empty prefix + then "without -for-pack" + else + Format.asprintf "with -for-pack %a" Compilation_unit.Prefix.print prefix in fprintf ppf "This input file cannot be compiled %s: it was generated %s." - (msg !Clflags.for_package) (msg saved) + (msg (Compilation_unit.Prefix.from_clflags ())) (msg saved) | Asm_generation(fn, err) -> fprintf ppf "Error producing assembly code for function %s: %a" diff --git a/asmcomp/asmgen.mli b/asmcomp/asmgen.mli index c258e24c9f1..35ddaab189e 100644 --- a/asmcomp/asmgen.mli +++ b/asmcomp/asmgen.mli @@ -43,7 +43,7 @@ val compile_phrase : type error = | Assembler_error of string - | Mismatched_for_pack of string option + | Mismatched_for_pack of Compilation_unit.Prefix.t | Asm_generation of string * Emitaux.error exception Error of error diff --git a/asmcomp/asmlink.ml b/asmcomp/asmlink.ml index d9b5753d46a..3817897278d 100644 --- a/asmcomp/asmlink.ml +++ b/asmcomp/asmlink.ml @@ -20,42 +20,43 @@ open Config open Cmx_format open Compilenv -module String = Misc.Stdlib.String +module CU = Compilation_unit type error = | File_not_found of filepath | Not_an_object_file of filepath - | Missing_implementations of (modname * string list) list - | Inconsistent_interface of modname * filepath * filepath - | Inconsistent_implementation of modname * filepath * filepath + | Missing_implementations of (Linkage_name.t * string list) list + | Inconsistent_interface of CU.Name.t * filepath * filepath + | Inconsistent_implementation of CU.Name.t * filepath * filepath | Assembler_error of filepath | Linking_error of int - | Multiple_definition of modname * filepath * filepath - | Missing_cmx of filepath * modname + | Multiple_definition of CU.Name.t * filepath * filepath + | Missing_cmx of filepath * CU.Name.t exception Error of error (* Consistency check between interfaces and implementations *) -module Cmi_consistbl = Consistbl.Make (Misc.Stdlib.String) +module Cmi_consistbl = Consistbl.Make (CU.Name) let crc_interfaces = Cmi_consistbl.create () -let interfaces = ref ([] : string list) +let interfaces = ref ([] : CU.Name.t list) -module Cmx_consistbl = Consistbl.Make (Misc.Stdlib.String) +module Cmx_consistbl = Consistbl.Make (CU.Name) let crc_implementations = Cmx_consistbl.create () -let implementations = ref ([] : string list) -let implementations_defined = ref ([] : (string * string) list) -let cmx_required = ref ([] : string list) +let implementations = ref ([] : CU.Name.t list) +let implementations_defined = ref ([] : (CU.Name.t * string) list) +let cmx_required = ref ([] : CU.Name.t list) let check_consistency file_name unit crc = begin try List.iter (fun (name, crco) -> + let name = CU.Name.of_string name in interfaces := name :: !interfaces; match crco with None -> () | Some crc -> - if name = unit.ui_name + if CU.Name.equal name (CU.name unit.ui_unit) then Cmi_consistbl.set crc_interfaces name crc file_name else Cmi_consistbl.check crc_interfaces name crc file_name) unit.ui_imports_cmi @@ -69,6 +70,7 @@ let check_consistency file_name unit crc = begin try List.iter (fun (name, crco) -> + let name = name |> CU.Name.of_string in implementations := name :: !implementations; match crco with None -> @@ -84,22 +86,27 @@ let check_consistency file_name unit crc = } -> raise(Error(Inconsistent_implementation(name, user, auth))) end; + let ui_name = CU.name unit.ui_unit in begin try - let source = List.assoc unit.ui_name !implementations_defined in - raise (Error(Multiple_definition(unit.ui_name, file_name, source))) + let source = List.assoc ui_name !implementations_defined in + raise (Error(Multiple_definition(CU.name unit.ui_unit, file_name, source))) with Not_found -> () end; - implementations := unit.ui_name :: !implementations; - Cmx_consistbl.set crc_implementations unit.ui_name crc file_name; + implementations := ui_name :: !implementations; + Cmx_consistbl.set crc_implementations ui_name crc file_name; implementations_defined := - (unit.ui_name, file_name) :: !implementations_defined; - if unit.ui_symbol <> unit.ui_name then - cmx_required := unit.ui_name :: !cmx_required + (ui_name, file_name) :: !implementations_defined; + if CU.is_packed unit.ui_unit then + cmx_required := ui_name :: !cmx_required -let extract_crc_interfaces () = +let extract_crc_interfaces0 () = Cmi_consistbl.extract !interfaces crc_interfaces +let extract_crc_interfaces () = + extract_crc_interfaces0 () + |> List.map (fun (name, crc) -> (name |> CU.Name.to_string, crc)) let extract_crc_implementations () = Cmx_consistbl.extract !implementations crc_implementations + |> List.map (fun (name, crc) -> (name |> CU.Name.to_string, crc)) (* Add C objects and options and "custom" info from a library descriptor. See bytecomp/bytelink.ml for comments on the order of C objects. *) @@ -126,7 +133,9 @@ let runtime_lib () = (* First pass: determine which units are needed *) -let missing_globals = (Hashtbl.create 17 : (string, string list ref) Hashtbl.t) +let missing_globals = + (Hashtbl.create 17 : + (Linkage_name.t, string list ref) Hashtbl.t) let is_required name = try ignore (Hashtbl.find missing_globals name); true @@ -184,11 +193,26 @@ let read_file obj_name = end else raise(Error(Not_an_object_file file_name)) -let scan_file file tolink = match file with +let linkage_name_of_modname modname = + (* We're the linker, so we assume that everything's already been packed, so + no module needs its prefix considered. *) + modname |> Linkage_name.of_string + +let scan_file file tolink = + match file with | Unit (file_name,info,crc) -> (* This is a .cmx file. It must be linked in any case. *) - remove_required info.ui_name; - List.iter (add_required file_name) info.ui_imports_cmx; + let linkage_name = + info.ui_unit + |> Compilation_unit.name + |> Compilation_unit.Name.to_string + |> linkage_name_of_modname + in + remove_required linkage_name; + List.iter (fun (name, crc) -> + let name = name |> linkage_name_of_modname in + add_required file_name (name, crc)) + info.ui_imports_cmx; (info, file_name, crc) :: tolink | Library (file_name,infos) -> (* This is an archive file. Each unit contained in it will be linked @@ -196,14 +220,21 @@ let scan_file file tolink = match file with add_ccobjs (Filename.dirname file_name) infos; List.fold_right (fun (info, crc) reqd -> + let ui_name = CU.name info.ui_unit in + let linkage_name = + ui_name |> CU.Name.to_string |> linkage_name_of_modname + in if info.ui_force_link || !Clflags.link_everything - || is_required info.ui_name + || is_required linkage_name then begin - remove_required info.ui_name; - List.iter (add_required (Printf.sprintf "%s(%s)" - file_name info.ui_name)) - info.ui_imports_cmx; + remove_required linkage_name; + let req_by = + Printf.sprintf "%s(%s)" file_name (ui_name |> CU.Name.to_string) + in + info.ui_imports_cmx |> List.iter (fun (modname, digest) -> + let linkage_name = modname |> Linkage_name.of_string in + add_required req_by (linkage_name, digest)); (info, file_name, crc) :: reqd end else reqd) @@ -216,23 +247,30 @@ let force_linking_of_startup ~ppf_dump = (Cmm.Cdata ([Cmm.Csymbol_address "caml_startup"])) let make_globals_map units_list ~crc_interfaces = - let crc_interfaces = String.Tbl.of_seq (List.to_seq crc_interfaces) in + let crc_interfaces = + crc_interfaces + |> CU.Name.Tbl.of_list + in let defined = List.map (fun (unit, _, impl_crc) -> - let intf_crc = String.Tbl.find crc_interfaces unit.ui_name in - String.Tbl.remove crc_interfaces unit.ui_name; - (unit.ui_name, intf_crc, Some impl_crc, unit.ui_defines)) + let name = CU.name unit.ui_unit in + let intf_crc = CU.Name.Tbl.find crc_interfaces name in + CU.Name.Tbl.remove crc_interfaces name; + let syms = List.map Symbol.for_compilation_unit unit.ui_defines in + (name, intf_crc, Some impl_crc, syms)) units_list in - String.Tbl.fold (fun name intf acc -> + CU.Name.Tbl.fold (fun name intf acc -> (name, intf, None, []) :: acc) crc_interfaces defined let make_startup_file ~ppf_dump units_list ~crc_interfaces = let compile_phrase p = Asmgen.compile_phrase ~ppf_dump p in Location.input_name := "caml_startup"; (* set name of "current" input *) - Compilenv.reset "_startup"; - (* set the name of the "current" compunit *) + let startup_comp_unit = + CU.create CU.Prefix.empty (CU.Name.of_string "_startup") + in + Compilenv.reset startup_comp_unit; Emit.begin_assembly (); let name_list = List.flatten (List.map (fun (info,_,_) -> info.ui_defines) units_list) in @@ -245,14 +283,22 @@ let make_startup_file ~ppf_dump units_list ~crc_interfaces = compile_phrase (Cmm_helpers.global_table name_list); let globals_map = make_globals_map units_list ~crc_interfaces in compile_phrase (Cmm_helpers.globals_map globals_map); - compile_phrase(Cmm_helpers.data_segment_table ("_startup" :: name_list)); - if !Clflags.function_sections then - compile_phrase - (Cmm_helpers.code_segment_table("_hot" :: "_startup" :: name_list)) - else - compile_phrase(Cmm_helpers.code_segment_table("_startup" :: name_list)); - let all_names = "_startup" :: "_system" :: name_list in - compile_phrase (Cmm_helpers.frame_table all_names); + compile_phrase + (Cmm_helpers.data_segment_table (startup_comp_unit :: name_list)); + (* CR mshinwell: We should have a separate notion of "backend compilation + unit" really, since the units here don't correspond to .ml source + files. *) + let hot_comp_unit = CU.create CU.Prefix.empty (CU.Name.of_string "_hot") in + let system_comp_unit = CU.create CU.Prefix.empty (CU.Name.of_string "_system") in + let code_comp_units = + if !Clflags.function_sections then + hot_comp_unit :: startup_comp_unit :: name_list + else + startup_comp_unit :: name_list + in + compile_phrase (Cmm_helpers.code_segment_table code_comp_units); + let all_comp_units = startup_comp_unit :: system_comp_unit :: name_list in + compile_phrase (Cmm_helpers.frame_table all_comp_units); if !Clflags.output_complete_object then force_linking_of_startup ~ppf_dump; Emit.end_assembly () @@ -260,14 +306,16 @@ let make_startup_file ~ppf_dump units_list ~crc_interfaces = let make_shared_startup_file ~ppf_dump units = let compile_phrase p = Asmgen.compile_phrase ~ppf_dump p in Location.input_name := "caml_startup"; - Compilenv.reset "_shared_startup"; + let shared_startup_comp_unit = + CU.create CU.Prefix.empty (CU.Name.of_string "_shared_startup") + in + Compilenv.reset shared_startup_comp_unit; Emit.begin_assembly (); List.iter compile_phrase (Cmm_helpers.generic_functions true (List.map fst units)); compile_phrase (Cmm_helpers.plugin_header units); compile_phrase - (Cmm_helpers.global_table - (List.map (fun (ui,_) -> ui.ui_symbol) units)); + (Cmm_helpers.global_table (List.map (fun (ui,_) -> ui.ui_unit) units)); if !Clflags.output_complete_object then force_linking_of_startup ~ppf_dump; (* this is to force a reference to all units, otherwise the linker @@ -342,7 +390,8 @@ let link ~ppf_dump objfiles output_name = else stdlib :: (objfiles @ [stdexit]) in let obj_infos = List.map read_file objfiles in let units_tolink = List.fold_right scan_file obj_infos [] in - Array.iter remove_required Runtimedef.builtin_exceptions; + Array.iter (fun name -> remove_required (name |> Linkage_name.of_string)) + Runtimedef.builtin_exceptions; begin match extract_missing_globals() with [] -> () | mg -> raise(Error(Missing_implementations mg)) @@ -350,7 +399,7 @@ let link ~ppf_dump objfiles output_name = List.iter (fun (info, file_name, crc) -> check_consistency file_name info crc) units_tolink; - let crc_interfaces = extract_crc_interfaces () in + let crc_interfaces = extract_crc_interfaces0 () in Clflags.ccobjs := !Clflags.ccobjs @ !lib_ccobjs; Clflags.all_ccopts := !lib_ccopts @ !Clflags.all_ccopts; (* put user's opts first *) @@ -389,7 +438,8 @@ let report_error ppf = function let print_modules ppf = List.iter (fun (md, rq) -> - fprintf ppf "@ @[%s referenced from %a@]" md + fprintf ppf "@ @[%a referenced from %a@]" + Linkage_name.print md print_references rq) in fprintf ppf "@[No implementations provided for the following modules:%a@]" @@ -397,37 +447,38 @@ let report_error ppf = function | Inconsistent_interface(intf, file1, file2) -> fprintf ppf "@[Files %a@ and %a@ make inconsistent assumptions \ - over interface %s@]" + over interface %a@]" Location.print_filename file1 Location.print_filename file2 - intf + CU.Name.print intf | Inconsistent_implementation(intf, file1, file2) -> fprintf ppf "@[Files %a@ and %a@ make inconsistent assumptions \ - over implementation %s@]" + over implementation %a@]" Location.print_filename file1 Location.print_filename file2 - intf + CU.Name.print intf | Assembler_error file -> fprintf ppf "Error while assembling %a" Location.print_filename file | Linking_error exitcode -> fprintf ppf "Error during linking (exit code %d)" exitcode | Multiple_definition(modname, file1, file2) -> fprintf ppf - "@[Files %a@ and %a@ both define a module named %s@]" + "@[Files %a@ and %a@ both define a module named %a@]" Location.print_filename file1 Location.print_filename file2 - modname + CU.Name.print modname | Missing_cmx(filename, name) -> fprintf ppf "@[File %a@ was compiled without access@ \ - to the .cmx file@ for module %s,@ \ + to the .cmx file@ for module %a,@ \ which was produced by `ocamlopt -for-pack'.@ \ Please recompile %a@ with the correct `-I' option@ \ - so that %s.cmx@ is found.@]" - Location.print_filename filename name + so that %a.cmx@ is found.@]" + Location.print_filename filename + CU.Name.print name Location.print_filename filename - name + CU.Name.print name let () = Location.register_error_of_exn diff --git a/asmcomp/asmlink.mli b/asmcomp/asmlink.mli index 6ee91ffb86d..3d31acab22b 100644 --- a/asmcomp/asmlink.mli +++ b/asmcomp/asmlink.mli @@ -32,13 +32,13 @@ val extract_crc_implementations: unit -> crcs type error = | File_not_found of filepath | Not_an_object_file of filepath - | Missing_implementations of (modname * string list) list - | Inconsistent_interface of modname * filepath * filepath - | Inconsistent_implementation of modname * filepath * filepath + | Missing_implementations of (Linkage_name.t * string list) list + | Inconsistent_interface of Compilation_unit.Name.t * filepath * filepath + | Inconsistent_implementation of Compilation_unit.Name.t * filepath * filepath | Assembler_error of filepath | Linking_error of int - | Multiple_definition of modname * filepath * filepath - | Missing_cmx of filepath * modname + | Multiple_definition of Compilation_unit.Name.t * filepath * filepath + | Missing_cmx of filepath * Compilation_unit.Name.t exception Error of error diff --git a/asmcomp/asmpackager.ml b/asmcomp/asmpackager.ml index 604fac5e52f..d5130fcae90 100644 --- a/asmcomp/asmpackager.ml +++ b/asmcomp/asmpackager.ml @@ -19,10 +19,12 @@ open Misc open Cmx_format +module CU = Compilation_unit + type error = - Illegal_renaming of string * string * string + Illegal_renaming of CU.Name.t * string * CU.Name.t | Forward_reference of string * string - | Wrong_for_pack of string * string + | Wrong_for_pack of string * CU.t | Linking_error | Assembler_error of string | File_not_found of string @@ -36,21 +38,21 @@ type pack_member_kind = PM_intf | PM_impl of unit_infos type pack_member = { pm_file: string; - pm_name: string; + pm_name: CU.Name.t; pm_kind: pack_member_kind } let read_member_info pack_path file = ( let name = - String.capitalize_ascii(Filename.basename(chop_extensions file)) in + String.capitalize_ascii(Filename.basename(chop_extensions file)) + |> CU.Name.of_string in let kind = if Filename.check_suffix file ".cmi" then PM_intf else begin let (info, crc) = Compilenv.read_unit_info file in - if info.ui_name <> name - then raise(Error(Illegal_renaming(name, file, info.ui_name))); - if info.ui_symbol <> - (Compilenv.current_unit_infos()).ui_symbol ^ "__" ^ info.ui_name + if not (CU.Name.equal (CU.name info.ui_unit) name) + then raise(Error(Illegal_renaming(name, file, (CU.name info.ui_unit)))); + if not (CU.is_parent pack_path ~child:info.ui_unit) then raise(Error(Wrong_for_pack(file, pack_path))); Asmlink.check_consistency file info crc; Compilenv.cache_unit_info info; @@ -70,7 +72,7 @@ let check_units members = | PM_impl infos -> List.iter (fun (unit, _) -> - if List.mem unit forbidden + if List.mem (unit |> Compilation_unit.Name.of_string) forbidden then raise(Error(Forward_reference(mb.pm_file, unit)))) infos.ui_imports_cmx end; @@ -89,13 +91,18 @@ let make_package_object ~ppf_dump members targetobj targetname coercion (* Put the full name of the module in the temporary file name to avoid collisions with MSVC's link /lib in case of successive packs *) - Filename.temp_file (Compilenv.make_symbol (Some "")) Config.ext_obj in + let name = + Symbol.for_current_unit () + |> Symbol.linkage_name + |> Linkage_name.to_string + in + Filename.temp_file name Config.ext_obj in let components = List.map (fun m -> match m.pm_kind with | PM_intf -> None - | PM_impl _ -> Some(Ident.create_persistent m.pm_name)) + | PM_impl _ -> Some(CU.Name.persistent_ident m.pm_name)) members in let module_ident = Ident.create_persistent targetname in let prefixname = Filename.remove_extension objtemp in @@ -166,7 +173,8 @@ let build_package_cmx members cmxfile = let unit_names = List.map (fun m -> m.pm_name) members in let filter lst = - List.filter (fun (name, _crc) -> not (List.mem name unit_names)) lst in + List.filter (fun (name, _crc) -> + not (List.mem (name |> CU.Name.of_string) unit_names)) lst in let union lst = List.fold_left (List.fold_left @@ -178,12 +186,16 @@ let build_package_cmx members cmxfile = match m.pm_kind with PM_intf -> accu | PM_impl info -> info :: accu) members [] in let pack_units = - List.fold_left - (fun set info -> - let unit_id = Compilenv.unit_id_from_name info.ui_name in - Compilation_unit.Set.add - (Compilenv.unit_for_global unit_id) set) - Compilation_unit.Set.empty units in + List.map (fun info -> info.ui_unit) units + |> Compilation_unit.Set.of_list + in + let ui = Compilenv.current_unit_infos() in + let pack = + (* CR-soon lmaurer: This is horrific, but the whole [import_for_pack] + business is about to go away. *) + Compilation_unit.Prefix.parse_for_pack + (Some (Compilation_unit.full_path_as_string ui.ui_unit)) + in let units = if Config.flambda then List.map (fun info -> @@ -191,21 +203,22 @@ let build_package_cmx members cmxfile = ui_export_info = Flambda (Export_info_for_pack.import_for_pack ~pack_units - ~pack:(Compilenv.current_unit ()) - (get_export_info info)) }) + ~pack + (get_export_info info)); + }) units else units in - let ui = Compilenv.current_unit_infos() in let ui_export_info = if Config.flambda then let ui_export_info = List.fold_left (fun acc info -> - Export_info.merge acc (get_export_info info)) - (Export_info_for_pack.import_for_pack ~pack_units - ~pack:(Compilenv.current_unit ()) - (get_export_info ui)) + Export_info.merge acc + (Export_info_for_pack.import_for_pack ~pack_units + ~pack + (get_export_info info))) + (get_export_info ui) units in Flambda ui_export_info @@ -213,14 +226,14 @@ let build_package_cmx members cmxfile = Clambda (get_approx ui) in Export_info_for_pack.clear_import_state (); + let ui_unit_as_string = CU.Name.to_string (CU.name ui.ui_unit) in let pkg_infos = - { ui_name = ui.ui_name; - ui_symbol = ui.ui_symbol; + { ui_unit = ui.ui_unit; ui_defines = List.flatten (List.map (fun info -> info.ui_defines) units) @ - [ui.ui_symbol]; + [ui.ui_unit]; ui_imports_cmi = - (ui.ui_name, Some (Env.crc_of_unit ui.ui_name)) :: + (ui_unit_as_string, Some (Env.crc_of_unit ui_unit_as_string)) :: filter(Asmlink.extract_crc_interfaces()); ui_imports_cmx = filter(Asmlink.extract_crc_implementations()); @@ -241,9 +254,10 @@ let build_package_cmx members cmxfile = let package_object_files ~ppf_dump files targetcmx targetobj targetname coercion ~backend = let pack_path = - match !Clflags.for_package with - | None -> targetname - | Some p -> p ^ "." ^ targetname in + let for_pack_prefix = CU.Prefix.from_clflags () in + let name = targetname |> CU.Name.of_string in + CU.create for_pack_prefix name + in let members = map_left_right (read_member_info pack_path) files in check_units members; make_package_object ~ppf_dump members targetobj targetname coercion ~backend; @@ -265,7 +279,11 @@ let package_files ~ppf_dump initial_env files targetcmx ~backend = (* Set the name of the current "input" *) Location.input_name := targetcmx; (* Set the name of the current compunit *) - Compilenv.reset ?packname:!Clflags.for_package targetname; + let comp_unit = + let for_pack_prefix = CU.Prefix.from_clflags () in + CU.create for_pack_prefix (CU.Name.of_string targetname) + in + Compilenv.reset comp_unit; Misc.try_finally (fun () -> let coercion = Typemod.package_units initial_env files targetcmi targetname in @@ -281,14 +299,14 @@ open Format let report_error ppf = function Illegal_renaming(name, file, id) -> fprintf ppf "Wrong file naming: %a@ contains the code for\ - @ %s when %s was expected" - Location.print_filename file name id + @ %a when %a was expected" + Location.print_filename file CU.Name.print name CU.Name.print id | Forward_reference(file, ident) -> fprintf ppf "Forward reference to %s in file %a" ident Location.print_filename file | Wrong_for_pack(file, path) -> - fprintf ppf "File %a@ was not compiled with the `-for-pack %s' option" - Location.print_filename file path + fprintf ppf "File %a@ was not compiled with the `-for-pack %a' option" + Location.print_filename file Compilation_unit.print path | File_not_found file -> fprintf ppf "File %s not found" file | Assembler_error file -> diff --git a/asmcomp/asmpackager.mli b/asmcomp/asmpackager.mli index 3ea2142540d..c3bfdcd9880 100644 --- a/asmcomp/asmpackager.mli +++ b/asmcomp/asmpackager.mli @@ -25,9 +25,9 @@ val package_files -> unit type error = - Illegal_renaming of string * string * string + Illegal_renaming of Compilation_unit.Name.t * string * Compilation_unit.Name.t | Forward_reference of string * string - | Wrong_for_pack of string * string + | Wrong_for_pack of string * Compilation_unit.t | Linking_error | Assembler_error of string | File_not_found of string diff --git a/asmcomp/cmm_helpers.ml b/asmcomp/cmm_helpers.ml index 8061e0d390c..f4a2822cba7 100644 --- a/asmcomp/cmm_helpers.ml +++ b/asmcomp/cmm_helpers.ml @@ -2725,6 +2725,16 @@ let emit_float_array_constant symb fields cont = emit_block symb (floatarray_header (List.length fields)) (Misc.map_end (fun f -> Cdouble f) fields cont) +let make_symbol ?compilation_unit name = + let compilation_unit = + match compilation_unit with + | None -> Compilation_unit.get_current_exn () + | Some compilation_unit -> compilation_unit + in + Symbol.for_name compilation_unit name + |> Symbol.linkage_name + |> Linkage_name.to_string + (* Generate the entry point *) let entry_point namelist = @@ -2740,7 +2750,7 @@ let entry_point namelist = let body = List.fold_right (fun name next -> - let entry_sym = Compilenv.make_symbol ~unitname:name (Some "entry") in + let entry_sym = make_symbol ~compilation_unit:name "entry" in Csequence(Cop(Capply(typ_void, Rc_normal), [cconst_symbol entry_sym], dbg ()), Csequence(incr_global_inited (), next))) @@ -2760,7 +2770,7 @@ let cint_zero = Cint 0n let global_table namelist = let mksym name = - Csymbol_address (Compilenv.make_symbol ~unitname:name (Some "gc_roots")) + Csymbol_address (make_symbol ~compilation_unit:name "gc_roots") in Cdata(Cglobal_symbol "caml_globals" :: Cdefine_symbol "caml_globals" :: @@ -2781,7 +2791,7 @@ let globals_map v = global_data "caml_globals_map" v let frame_table namelist = let mksym name = - Csymbol_address (Compilenv.make_symbol ~unitname:name (Some "frametable")) + Csymbol_address (make_symbol ~compilation_unit:name "frametable") in Cdata(Cglobal_symbol "caml_frametable" :: Cdefine_symbol "caml_frametable" :: @@ -2792,9 +2802,9 @@ let frame_table namelist = let segment_table namelist symbol begname endname = let addsyms name lst = - Csymbol_address (Compilenv.make_symbol ~unitname:name (Some begname)) :: - Csymbol_address (Compilenv.make_symbol ~unitname:name (Some endname)) :: - lst + Csymbol_address (make_symbol ~compilation_unit:name begname) + :: Csymbol_address (make_symbol ~compilation_unit:name endname) + :: lst in Cdata(Cglobal_symbol symbol :: Cdefine_symbol symbol :: @@ -2829,8 +2839,9 @@ let predef_exception i name = (* Header for a plugin *) let plugin_header units = + let module CU = Compilation_unit in let mk ((ui : Cmx_format.unit_infos),crc) : Cmxs_format.dynunit = - { dynu_name = ui.ui_name; + { dynu_name = CU.name ui.ui_unit; dynu_crc = crc; dynu_imports_cmi = ui.ui_imports_cmi; dynu_imports_cmx = ui.ui_imports_cmx; @@ -2914,7 +2925,7 @@ let emit_constant_closure ((_, global_symb) as symb) fundecls clos_vars cont = (* Build the NULL terminated array of gc roots *) let emit_gc_roots_table ~symbols cont = - let table_symbol = Compilenv.make_symbol (Some "gc_roots") in + let table_symbol = make_symbol "gc_roots" in Cdata(Cglobal_symbol table_symbol :: Cdefine_symbol table_symbol :: List.map (fun s -> Csymbol_address s) symbols @ diff --git a/asmcomp/cmm_helpers.mli b/asmcomp/cmm_helpers.mli index 7e4c82d752b..e3de3111283 100644 --- a/asmcomp/cmm_helpers.mli +++ b/asmcomp/cmm_helpers.mli @@ -583,26 +583,30 @@ val placeholder_dbg : unit -> Debuginfo.t val placeholder_fun_dbg : human_name:string -> Debuginfo.t (** Entry point *) -val entry_point : string list -> phrase +val entry_point : Compilation_unit.t list -> phrase (** Generate the caml_globals table *) -val global_table: string list -> phrase +val global_table: Compilation_unit.t list -> phrase (** Add references to the given symbols *) val reference_symbols: string list -> phrase -(** Generate the caml_globals_map structure, as a marshalled string constant *) +(** Generate the caml_globals_map structure, as a marshalled string constant. + The runtime representation of the type here must match that of [type + global_map] in the natdynlink code. *) val globals_map: - (string * Digest.t option * Digest.t option * string list) list -> phrase + (Compilation_unit.Name.t * Digest.t option * Digest.t option * Symbol.t list) + list -> + phrase (** Generate the caml_frametable table, referencing the frametables from the given compilation units *) -val frame_table: string list -> phrase +val frame_table: Compilation_unit.t list -> phrase (** Generate the tables for data and code positions respectively of the given compilation units *) -val data_segment_table: string list -> phrase -val code_segment_table: string list -> phrase +val data_segment_table: Compilation_unit.t list -> phrase +val code_segment_table: Compilation_unit.t list -> phrase (** Generate data for a predefined exception *) val predef_exception: int -> string -> phrase @@ -650,3 +654,5 @@ val emit_constant_closure : val emit_preallocated_blocks : Clambda.preallocated_block list -> phrase list -> phrase list + +val make_symbol : ?compilation_unit:Compilation_unit.t -> string -> string diff --git a/asmcomp/cmmgen.ml b/asmcomp/cmmgen.ml index 7b851f82481..135e7683050 100644 --- a/asmcomp/cmmgen.ml +++ b/asmcomp/cmmgen.ml @@ -1507,7 +1507,7 @@ let compunit (ulam, preallocated_blocks, constants) = (fun () -> dbg) else transl empty_env ulam in - let c1 = [Cfunction {fun_name = Compilenv.make_symbol (Some "entry"); + let c1 = [Cfunction {fun_name = make_symbol "entry"; fun_args = []; fun_body = init_code; (* This function is often large and run only once. diff --git a/asmcomp/debug/reg_availability_set.ml b/asmcomp/debug/reg_availability_set.ml index fbff598d1f5..40e7a6638db 100644 --- a/asmcomp/debug/reg_availability_set.ml +++ b/asmcomp/debug/reg_availability_set.ml @@ -76,7 +76,7 @@ let canonicalise availability = | None -> () | Some debug_info -> let name = RD.Debug_info.holds_value_of debug_info in - if not (V.persistent name) then begin + if not (V.is_global_or_predef name) then begin match V.Tbl.find regs_by_ident name with | exception Not_found -> V.Tbl.add regs_by_ident name reg | (reg' : RD.t) -> diff --git a/asmcomp/i386/emit.mlp b/asmcomp/i386/emit.mlp index b16d36d41d9..b77445bc979 100644 --- a/asmcomp/i386/emit.mlp +++ b/asmcomp/i386/emit.mlp @@ -482,7 +482,7 @@ let emit_float_constant cst lbl = emit_float64_split_directive cst let emit_global_label s = - let lbl = Compilenv.make_symbol (Some s) in + let lbl = Cmm_helpers.make_symbol s in add_def_symbol lbl; let lbl = emit_symbol lbl in D.global lbl; @@ -1042,7 +1042,7 @@ let begin_assembly() = D.data (); emit_global_label "data_begin"; - emit_named_text_section (Compilenv.make_symbol (Some "code_begin")); + emit_named_text_section (Cmm_helpers.make_symbol "code_begin"); emit_global_label "code_begin" let end_assembly() = @@ -1051,7 +1051,7 @@ let end_assembly() = List.iter (fun (cst,lbl) -> emit_float_constant cst lbl) !float_constants end; - emit_named_text_section (Compilenv.make_symbol (Some "code_end")); + emit_named_text_section (Cmm_helpers.make_symbol "code_end"); emit_global_label "code_end"; D.data (); diff --git a/asmcomp/power/emit.mlp b/asmcomp/power/emit.mlp index 61389be2777..0a4ebaf26d2 100644 --- a/asmcomp/power/emit.mlp +++ b/asmcomp/power/emit.mlp @@ -1182,17 +1182,19 @@ let begin_assembly() = end; Hashtbl.clear tocref_entries; (* Emit the beginning of the segments *) - let lbl_begin = Compilenv.make_symbol (Some "data_begin") in + let lbl_begin = Cmm_helpers.make_symbol "data_begin" in emit_string data_space; declare_global_data lbl_begin; `{emit_symbol lbl_begin}:\n`; - let lbl_begin = Compilenv.make_symbol (Some "code_begin") in + let lbl_begin = Cmm_helpers.make_symbol "code_begin" in emit_string function_descr_space; (* For the ELF64v1 ABI, we must make sure that the .opd and .data sections are in different pages. .opd comes after .data, so aligning .opd is enough. To save space, we do it only for the startup file, not for every OCaml compilation unit. *) - let c = Compilenv.current_unit_name() in + let c = + Compilation_unit.get_current_exn () |> Compilation_unit.full_path_as_string + in if abi = ELF64v1 && (c = "_startup" || c = "_shared_startup") then begin ` .p2align 12\n` end; @@ -1202,12 +1204,12 @@ let begin_assembly() = let end_assembly() = (* Emit the end of the segments *) emit_string function_descr_space; - let lbl_end = Compilenv.make_symbol (Some "code_end") in + let lbl_end = Cmm_helpers.make_symbol "code_end" in declare_global_data lbl_end; `{emit_symbol lbl_end}:\n`; if abi <> ELF64v1 then ` .long 0\n`; emit_string data_space; - let lbl_end = Compilenv.make_symbol (Some "data_end") in + let lbl_end = Cmm_helpers.make_symbol "data_end" in declare_global_data lbl_end; ` {emit_string datag} 0\n`; (* PR#6329 *) `{emit_symbol lbl_end}:\n`; @@ -1215,7 +1217,7 @@ let end_assembly() = (* Emit the frame descriptors *) emit_string data_space; (* not rodata_space because it contains relocations *) if ppc64 then ` .align 3\n`; (* #7887 *) - let lbl = Compilenv.make_symbol (Some "frametable") in + let lbl = Cmm_helpers.make_symbol "frametable" in declare_global_data lbl; `{emit_symbol lbl}:\n`; emit_frames diff --git a/asmcomp/riscv/emit.mlp b/asmcomp/riscv/emit.mlp index b1ddf87b79e..85ece08f4b0 100644 --- a/asmcomp/riscv/emit.mlp +++ b/asmcomp/riscv/emit.mlp @@ -644,30 +644,30 @@ let begin_assembly() = ` .file \"\"\n`; (* PR#7073 *) reset_debug_info (); (* Emit the beginning of the segments *) - let lbl_begin = Compilenv.make_symbol (Some "data_begin") in + let lbl_begin = Cmm_helpers.make_symbol "data_begin" in ` {emit_string data_space}\n`; declare_global_data lbl_begin; `{emit_symbol lbl_begin}:\n`; - let lbl_begin = Compilenv.make_symbol (Some "code_begin") in + let lbl_begin = Cmm_helpers.make_symbol "code_begin" in ` {emit_string code_space}\n`; declare_global_data lbl_begin; `{emit_symbol lbl_begin}:\n` let end_assembly() = ` {emit_string code_space}\n`; - let lbl_end = Compilenv.make_symbol (Some "code_end") in + let lbl_end = Cmm_helpers.make_symbol "code_end" in declare_global_data lbl_end; `{emit_symbol lbl_end}:\n`; ` .long 0\n`; ` {emit_string data_space}\n`; - let lbl_end = Compilenv.make_symbol (Some "data_end") in + let lbl_end = Cmm_helpers.make_symbol "data_end" in declare_global_data lbl_end; ` .quad 0\n`; (* PR#6329 *) `{emit_symbol lbl_end}:\n`; ` .quad 0\n`; (* Emit the frame descriptors *) ` {emit_string rodata_space}\n`; - let lbl = Compilenv.make_symbol (Some "frametable") in + let lbl = Cmm_helpers.make_symbol "frametable" in declare_global_data lbl; `{emit_symbol lbl}:\n`; emit_frames diff --git a/asmcomp/s390x/emit.mlp b/asmcomp/s390x/emit.mlp index 8bf18ac5664..4b1c51e61d3 100644 --- a/asmcomp/s390x/emit.mlp +++ b/asmcomp/s390x/emit.mlp @@ -756,12 +756,12 @@ let begin_assembly() = reset_debug_info(); ` .file \"\"\n`; (* PR#7037 *) (* Emit the beginning of the segments *) - let lbl_begin = Compilenv.make_symbol (Some "data_begin") in + let lbl_begin = Cmm_helpers.make_symbol "data_begin" in emit_string data_space; ` .align 8\n`; declare_global_data lbl_begin; `{emit_symbol lbl_begin}:\n`; - let lbl_begin = Compilenv.make_symbol (Some "code_begin") in + let lbl_begin = Cmm_helpers.make_symbol "code_begin" in emit_string code_space; declare_global_data lbl_begin; `{emit_symbol lbl_begin}:\n` @@ -769,13 +769,13 @@ let begin_assembly() = let end_assembly() = (* Emit the end of the segments *) emit_string code_space; - let lbl_end = Compilenv.make_symbol (Some "code_end") in + let lbl_end = Cmm_helpers.make_symbol "code_end" in declare_global_data lbl_end; `{emit_symbol lbl_end}:\n`; ` .long 0\n`; emit_string data_space; ` .align 8\n`; - let lbl_end = Compilenv.make_symbol (Some "data_end") in + let lbl_end = Cmm_helpers.make_symbol "data_end" in declare_global_data lbl_end; ` .quad 0\n`; (* PR#6329 *) `{emit_symbol lbl_end}:\n`; @@ -783,7 +783,7 @@ let end_assembly() = (* Emit the frame descriptors *) emit_string data_space; (* not rodata because relocations inside *) ` .align 8\n`; - let lbl = Compilenv.make_symbol (Some "frametable") in + let lbl = Cmm_helpers.make_symbol "frametable" in declare_global_data lbl; `{emit_symbol lbl}:\n`; emit_frames diff --git a/bytecomp/bytelibrarian.ml b/bytecomp/bytelibrarian.ml index 294a6976ab9..045f412a3ab 100644 --- a/bytecomp/bytelibrarian.ml +++ b/bytecomp/bytelibrarian.ml @@ -67,7 +67,7 @@ let copy_object_file oc name = if buffer = cmo_magic_number then begin let compunit_pos = input_binary_int ic in seek_in ic compunit_pos; - let compunit = (input_value ic : compilation_unit) in + let compunit = (input_value ic : compilation_unit_descr) in Bytelink.check_consistency file_name compunit; copy_compunit ic oc compunit; close_in ic; diff --git a/bytecomp/bytelink.ml b/bytecomp/bytelink.ml index fd5bd490aa7..8aa8f4d9295 100644 --- a/bytecomp/bytelink.ml +++ b/bytecomp/bytelink.ml @@ -19,6 +19,8 @@ open Misc open Config open Cmo_format +module CU = Compilation_unit + type error = | File_not_found of filepath | Not_an_object_file of filepath @@ -34,9 +36,9 @@ type error = exception Error of error type link_action = - Link_object of string * compilation_unit + Link_object of string * compilation_unit_descr (* Name of .cmo file and descriptor of the unit *) - | Link_archive of string * compilation_unit list + | Link_archive of string * compilation_unit_descr list (* Name of .cma file and descriptors of the units to be linked. *) (* Add C objects and options from a library descriptor *) @@ -122,7 +124,7 @@ let scan_file obj_name tolink = requires. *) let compunit_pos = input_binary_int ic in (* Go to descriptor *) seek_in ic compunit_pos; - let compunit = (input_value ic : compilation_unit) in + let compunit = (input_value ic : compilation_unit_descr) in close_in ic; add_required compunit; List.iter remove_required compunit.cu_reloc; @@ -174,7 +176,7 @@ let check_consistency file_name cu = match crco with None -> () | Some crc -> - if name = cu.cu_name + if CU.Name.equal (CU.Name.of_string name) cu.cu_name then Consistbl.set crc_interfaces name crc file_name else Consistbl.check crc_interfaces name crc file_name) cu.cu_imports @@ -185,16 +187,17 @@ let check_consistency file_name cu = } -> raise(Error(Inconsistent_import(name, user, auth))) end; + let cu_name = CU.Name.to_string cu.cu_name in begin try - let source = List.assoc cu.cu_name !implementations_defined in + let source = List.assoc cu_name !implementations_defined in Location.prerr_warning (Location.in_file file_name) - (Warnings.Module_linked_twice(cu.cu_name, + (Warnings.Module_linked_twice(cu_name, Location.show_filename file_name, Location.show_filename source)) with Not_found -> () end; implementations_defined := - (cu.cu_name, file_name) :: !implementations_defined + (cu_name, file_name) :: !implementations_defined let extract_crc_interfaces () = Consistbl.extract !interfaces crc_interfaces @@ -249,7 +252,7 @@ let link_archive output_fun currpos_fun file_name units_required = try List.iter (fun cu -> - let name = file_name ^ "(" ^ cu.cu_name ^ ")" in + let name = file_name ^ "(" ^ (CU.Name.to_string cu.cu_name) ^ ")" in try link_compunit output_fun currpos_fun inchan name cu with Symtable.Error msg -> @@ -627,6 +630,7 @@ let link objfiles output_name = match Ident.Map.bindings missing_modules with | [] -> () | (id, cu_name) :: _ -> + let cu_name = CU.Name.to_string cu_name in raise (Error (Required_module_unavailable (Ident.name id, cu_name))) end; Clflags.ccobjs := !Clflags.ccobjs @ !lib_ccobjs; (* put user's libs last *) diff --git a/bytecomp/bytelink.mli b/bytecomp/bytelink.mli index 82f851e6ef3..c5a992507a3 100644 --- a/bytecomp/bytelink.mli +++ b/bytecomp/bytelink.mli @@ -20,7 +20,7 @@ open Misc val link : filepath list -> filepath -> unit val reset : unit -> unit -val check_consistency: filepath -> Cmo_format.compilation_unit -> unit +val check_consistency: filepath -> Cmo_format.compilation_unit_descr -> unit val extract_crc_interfaces: unit -> crcs diff --git a/bytecomp/bytepackager.ml b/bytecomp/bytepackager.ml index 2458030bd14..aeb843b6c49 100644 --- a/bytecomp/bytepackager.ml +++ b/bytecomp/bytepackager.ml @@ -19,6 +19,8 @@ open Misc open Instruct open Cmo_format + +module CU = Compilation_unit module String = Misc.Stdlib.String type error = @@ -89,7 +91,7 @@ let relocate_debug base prefix subst ev = (* Read the unit information from a .cmo file. *) -type pack_member_kind = PM_intf | PM_impl of compilation_unit +type pack_member_kind = PM_intf | PM_impl of compilation_unit_descr type pack_member = { pm_file: string; @@ -113,9 +115,10 @@ let read_member_info file = ( raise(Error(Not_an_object_file file)); let compunit_pos = input_binary_int ic in seek_in ic compunit_pos; - let compunit = (input_value ic : compilation_unit) in - if compunit.cu_name <> name - then raise(Error(Illegal_renaming(name, file, compunit.cu_name))); + let compunit = (input_value ic : compilation_unit_descr) in + if not (CU.Name.equal compunit.cu_name (CU.Name.of_string name)) + then raise(Error(Illegal_renaming(name, file, + CU.Name.to_string compunit.cu_name))); close_in ic; PM_impl compunit with x -> @@ -255,7 +258,7 @@ let package_object_files ~ppf_dump files targetfile targetname coercion = (fun (name, _crc) -> not (List.mem name unit_names)) (Bytelink.extract_crc_interfaces()) in let compunit = - { cu_name = targetname; + { cu_name = CU.Name.of_string targetname; cu_pos = pos_code; cu_codesize = pos_debug - pos_code; cu_reloc = List.rev !relocs; diff --git a/bytecomp/emitcode.ml b/bytecomp/emitcode.ml index 8eefde578c8..ea185b3775f 100644 --- a/bytecomp/emitcode.ml +++ b/bytecomp/emitcode.ml @@ -408,7 +408,7 @@ let to_file outchan unit_name objfile ~required_globals code = end else (0, 0) in let compunit = - { cu_name = unit_name; + { cu_name = Compilation_unit.Name.of_string unit_name; cu_pos = pos_code; cu_codesize = !out_position; cu_reloc = List.rev !reloc_info; diff --git a/compilerlibs/Makefile.compilerlibs b/compilerlibs/Makefile.compilerlibs index 801912fefc2..dea0b0a3b77 100644 --- a/compilerlibs/Makefile.compilerlibs +++ b/compilerlibs/Makefile.compilerlibs @@ -31,7 +31,9 @@ UTILS=utils/config.cmo utils/build_path_prefix_map.cmo utils/misc.cmo \ utils/terminfo.cmo utils/ccomp.cmo utils/warnings.cmo \ utils/consistbl.cmo utils/strongly_connected_components.cmo \ utils/targetint.cmo utils/int_replace_polymorphic_compare.cmo \ - utils/domainstate.cmo utils/binutils.cmo utils/target_system.cmo + utils/domainstate.cmo utils/binutils.cmo utils/target_system.cmo \ + typing/ident.cmo \ + utils/compilation_unit.cmo utils/linkage_name.cmo utils/symbol.cmo UTILS_CMI= PARSING=parsing/location.cmo parsing/longident.cmo \ @@ -47,7 +49,7 @@ PARSING_CMI=\ parsing/asttypes.cmi \ parsing/parsetree.cmi -TYPING=typing/ident.cmo typing/path.cmo \ +TYPING=typing/path.cmo \ typing/primitive.cmo typing/type_immediacy.cmo typing/types.cmo \ typing/btype.cmo typing/oprint.cmo \ typing/subst.cmo typing/predef.cmo \ @@ -218,12 +220,10 @@ MIDDLE_END_FLAMBDA_CMI=\ MIDDLE_END=\ middle_end/internal_variable_names.cmo \ - middle_end/linkage_name.cmo \ - middle_end/compilation_unit.cmo \ middle_end/variable.cmo \ middle_end/flambda/base_types/closure_element.cmo \ middle_end/flambda/base_types/closure_id.cmo \ - middle_end/symbol.cmo \ + middle_end/symbol_utils.cmo \ middle_end/backend_var.cmo \ middle_end/clambda_primitives.cmo \ middle_end/printclambda_primitives.cmo \ diff --git a/debugger/eval.ml b/debugger/eval.ml index 240ea882c51..3ed3a250d5d 100644 --- a/debugger/eval.ml +++ b/debugger/eval.ml @@ -42,7 +42,7 @@ let abstract_type = let rec address path event = function | Env.Aident id -> - if Ident.global id then + if Ident.is_global_or_predef id then try Debugcom.Remote_value.global (Symtable.get_global_position id) with Symtable.Error _ -> raise(Error(Unbound_identifier id)) diff --git a/debugger/loadprinter.ml b/debugger/loadprinter.ml index 3cb66a09bc5..696ce3cd1e9 100644 --- a/debugger/loadprinter.ml +++ b/debugger/loadprinter.ml @@ -73,7 +73,7 @@ let loadfile ppf name = let rec eval_address = function | Env.Aident id -> - assert (Ident.persistent id); + assert (Ident.is_global id); let bytecode_or_asm_symbol = Ident.name id in begin match Dynlink.unsafe_get_global_value ~bytecode_or_asm_symbol with | None -> diff --git a/driver/compenv.ml b/driver/compenv.ml index 0cd325dcb60..6623c5940fa 100644 --- a/driver/compenv.ml +++ b/driver/compenv.ml @@ -91,7 +91,11 @@ let module_of_filename inputfile outputprefix = let basename = Filename.basename outputprefix in let name = try - let pos = String.index basename '.' in + (* For hidden files (i.e., those starting with '.'), include the initial + '.' in the module name rather than let it be empty. It's still not a + /good/ module name, but at least it's not rejected out of hand by + [Compilation_unit.Name.of_string]. *) + let pos = String.index_from basename 1 '.' in String.sub basename 0 pos with Not_found -> basename in diff --git a/driver/main_args.ml b/driver/main_args.ml index 936f61fd7f7..6b046eda805 100644 --- a/driver/main_args.ml +++ b/driver/main_args.ml @@ -1910,7 +1910,7 @@ module Default = struct let _dtimings () = profile_columns := [`Time] let _dtimings_precision n = timings_precision := n let _dump_into_file = set dump_into_file - let _for_pack s = for_package := (Some s) + let _for_pack s = for_package := (Some (String.capitalize_ascii s)) let _g = set debug let _i = set print_types let _impl = Compenv.impl diff --git a/driver/optcompile.ml b/driver/optcompile.ml index 84accf768e6..c698635ac41 100644 --- a/driver/optcompile.ml +++ b/driver/optcompile.ml @@ -82,15 +82,23 @@ let clambda i backend typed = ~ppf_dump:i.ppf_dump; Compilenv.save_unit_info (cmx i)) +let reset_compilenv ~module_name = + let for_pack_prefix = Compilation_unit.Prefix.from_clflags () in + let comp_unit = + Compilation_unit.create for_pack_prefix + (Compilation_unit.Name.of_string module_name) + in + Compilenv.reset comp_unit + (* Emit assembly directly from Linear IR *) let emit i = - Compilenv.reset ?packname:!Clflags.for_package i.module_name; + reset_compilenv ~module_name:i.module_name; Asmgen.compile_implementation_linear i.output_prefix ~progname:i.source_file let implementation ~backend ~start_from ~source_file ~output_prefix ~keep_symbol_tables:_ = let backend info typed = - Compilenv.reset ?packname:!Clflags.for_package info.module_name; + reset_compilenv ~module_name:info.module_name; if Config.flambda then flambda info backend typed else clambda info backend typed diff --git a/driver/optmaindriver.ml b/driver/optmaindriver.ml index 5f05bb47f9d..d004bad907a 100644 --- a/driver/optmaindriver.ml +++ b/driver/optmaindriver.ml @@ -18,8 +18,8 @@ open Clflags module Backend = struct (* See backend_intf.mli. *) - let symbol_for_global' = Compilenv.symbol_for_global' - let closure_symbol = Compilenv.closure_symbol + let pack_prefix_for_global_ident id = + Compilenv.pack_prefix_for_global_ident id let really_import_approx = Import_approx.really_import_approx let import_symbol = Import_approx.import_symbol diff --git a/dune b/dune index b4e9dcc13d3..efeb5c67fd7 100644 --- a/dune +++ b/dune @@ -62,7 +62,7 @@ config build_path_prefix_map misc identifiable numbers arg_helper clflags profile terminfo ccomp warnings consistbl strongly_connected_components targetint load_path int_replace_polymorphic_compare domainstate binutils - local_store target_system + local_store target_system compilation_unit linkage_name symbol ;; PARSING location longident docstrings syntaxerr ast_helper camlinternalMenhirLib @@ -85,7 +85,7 @@ ;; lambda/ debuginfo lambda matching printlambda runtimedef simplif switch - translattribute translclass translcomprehension translcore translmod + translattribute translclass translcomprehension translcore translmod translobj translprim ;; bytecomp/ @@ -332,5 +332,8 @@ (cmo_format.mli as compiler-libs/cmo_format.mli) (debug_event.mli as compiler-libs/debug_event.mli) (domainstate.mli as compiler-libs/domainstate.mli) + (compilation_unit.mli as compiler-libs/compilation_unit.mli) + (linkage_name.mli as compiler-libs/linkage_name.mli) + (symbol.mli as compiler-libs/symbol.mli) )) diff --git a/file_formats/cmo_format.mli b/file_formats/cmo_format.mli index 0952157b37a..64c5ad098e1 100644 --- a/file_formats/cmo_format.mli +++ b/file_formats/cmo_format.mli @@ -27,8 +27,8 @@ type reloc_info = (* Descriptor for compilation units *) -type compilation_unit = - { cu_name: modname; (* Name of compilation unit *) +type compilation_unit_descr = + { cu_name: Compilation_unit.Name.t; (* Name of compilation unit *) mutable cu_pos: int; (* Absolute position in file *) cu_codesize: int; (* Size of code block *) cu_reloc: (reloc_info * int) list; (* Relocation information *) @@ -51,7 +51,7 @@ type compilation_unit = (* Descriptor for libraries *) type library = - { lib_units: compilation_unit list; (* List of compilation units *) + { lib_units: compilation_unit_descr list; (* List of compilation units *) lib_custom: bool; (* Requires custom mode linking? *) (* In the following fields the lists are reversed with respect to how they end up being used on the command line. *) diff --git a/file_formats/cmx_format.mli b/file_formats/cmx_format.mli index 810d49636d4..840695b4eaf 100644 --- a/file_formats/cmx_format.mli +++ b/file_formats/cmx_format.mli @@ -37,9 +37,13 @@ type export_info = type apply_fn := int * Lambda.alloc_mode type unit_infos = - { mutable ui_name: modname; (* Name of unit implemented *) - mutable ui_symbol: string; (* Prefix for symbols *) - mutable ui_defines: string list; (* Unit and sub-units implemented *) + (* CR lmaurer: Consider renaming [ui_name], say to [ui_unit]. Code like + [Compilation_unit.name ui_name] makes me wonder what a name's name is. *) + { mutable ui_unit: Compilation_unit.t; (* Compilation unit implemented *) + mutable ui_defines: Compilation_unit.t list; + (* All compilation units in the + .cmx file (i.e. [ui_name] and + any produced via [Asmpackager]) *) mutable ui_imports_cmi: crcs; (* Interfaces imported *) mutable ui_imports_cmx: crcs; (* Infos imported *) mutable ui_curry_fun: Clambda.arity list; (* Currying functions needed *) diff --git a/file_formats/cmxs_format.mli b/file_formats/cmxs_format.mli index c670024f928..f375a341ef4 100644 --- a/file_formats/cmxs_format.mli +++ b/file_formats/cmxs_format.mli @@ -22,11 +22,11 @@ open Misc (as an externed record) *) type dynunit = { - dynu_name: modname; + dynu_name: Compilation_unit.Name.t; dynu_crc: Digest.t; dynu_imports_cmi: crcs; dynu_imports_cmx: crcs; - dynu_defines: string list; + dynu_defines: Compilation_unit.t list; } type dynheader = { diff --git a/file_formats/linear_format.ml b/file_formats/linear_format.ml index 5525a697076..42802c728d8 100644 --- a/file_formats/linear_format.ml +++ b/file_formats/linear_format.ml @@ -22,9 +22,8 @@ type linear_item_info = type linear_unit_info = { - mutable unit_name : string; + mutable unit : Compilation_unit.t; mutable items : linear_item_info list; - mutable for_pack : string option } type error = diff --git a/file_formats/linear_format.mli b/file_formats/linear_format.mli index 766db5db24e..dce539a8b64 100644 --- a/file_formats/linear_format.mli +++ b/file_formats/linear_format.mli @@ -25,9 +25,8 @@ type linear_item_info = type linear_unit_info = { - mutable unit_name : string; + mutable unit : Compilation_unit.t; mutable items : linear_item_info list; - mutable for_pack : string option } (* Marshal and unmarshal a compilation unit in Linear format. diff --git a/lambda/lambda.ml b/lambda/lambda.ml index 1b456631c1c..27a3f5b929c 100644 --- a/lambda/lambda.ml +++ b/lambda/lambda.ml @@ -830,7 +830,7 @@ let rec patch_guarded patch = function let rec transl_address loc = function | Env.Aident id -> - if Ident.global id + if Ident.is_global_or_predef id then Lprim(Pgetglobal id, [], loc) else Lvar id | Env.Adot(addr, pos) -> diff --git a/lambda/translprim.ml b/lambda/translprim.ml index 1dd2ec4816e..4750492883a 100644 --- a/lambda/translprim.ml +++ b/lambda/translprim.ml @@ -95,7 +95,8 @@ let add_used_primitive loc env path = Some (Path.Pdot _ as path) -> let path = Env.normalize_path_prefix (Some loc) env path in let unit = Path.head path in - if Ident.global unit && not (Hashtbl.mem used_primitives path) + if Ident.is_global_or_predef unit + && not (Hashtbl.mem used_primitives path) then Hashtbl.add used_primitives path loc | _ -> () diff --git a/middle_end/backend_intf.mli b/middle_end/backend_intf.mli index c9e009283cf..ee5257387e2 100644 --- a/middle_end/backend_intf.mli +++ b/middle_end/backend_intf.mli @@ -19,8 +19,9 @@ (** Knowledge that the middle end needs about the backend. *) module type S = sig - (** Compute the symbol for the given identifier. *) - val symbol_for_global' : (Ident.t -> Symbol.t) + (** Compute the pack prefix for the given identifier. *) + (* CR mshinwell: rename to pack_prefix_for_global_ident *) + val pack_prefix_for_global_ident : (Ident.t -> Compilation_unit.Prefix.t) (** If the given approximation is that of a symbol (Value_symbol) or an external (Value_extern), attempt to find a more informative @@ -30,8 +31,6 @@ module type S = sig val import_symbol : Symbol.t -> Simple_value_approx.t - val closure_symbol : Closure_id.t -> Symbol.t - (** The natural size of an integer on the target architecture (cf. [Arch.size_int] in the native code backend). *) val size_int : int diff --git a/middle_end/closure/closure.ml b/middle_end/closure/closure.ml index 3404c172e09..6684107ca36 100644 --- a/middle_end/closure/closure.ml +++ b/middle_end/closure/closure.ml @@ -63,7 +63,8 @@ let rec build_closure_env env_param pos = function contain the right names if the -for-pack option is active. *) let getglobal dbg id = - Uprim(P.Pread_symbol (Compilenv.symbol_for_global id), [], dbg) + let symbol = Compilenv.symbol_for_global id |> Linkage_name.to_string in + Uprim (P.Pread_symbol symbol, [], dbg) let region ulam = let is_trivial = @@ -1399,7 +1400,11 @@ and close_functions { backend; fenv; cenv; mutable_vars } fun_defs = (id, Lfunction({kind; params; return; body; loc; mode; region} as funct)) -> Lambda.check_lfunction funct; - let label = Compilenv.make_symbol (Some (V.unique_name id)) in + let label = + Symbol.for_local_ident id + |> Symbol.linkage_name + |> Linkage_name.to_string + in let arity = List.length params in let fundesc = {fun_label = label; @@ -1647,7 +1652,11 @@ let reset () = let intro ~backend ~size lam = reset (); - let id = Compilenv.make_symbol None in + let id = + Symbol.for_current_unit () + |> Symbol.linkage_name + |> Linkage_name.to_string + in global_approx := Array.init size (fun i -> Value_global_field (id, i)); Compilenv.set_global_approx(Value_tuple (alloc_heap, !global_approx)); let (ulam, _approx) = @@ -1656,7 +1665,9 @@ let intro ~backend ~size lam = in let opaque = !Clflags.opaque - || Env.is_imported_opaque (Compilenv.current_unit_name ()) + || Env.is_imported_opaque + (Compilation_unit.get_current_exn () + |> Compilation_unit.full_path_as_string) in if opaque then Compilenv.set_global_approx(Value_unknown) diff --git a/middle_end/closure/closure_middle_end.ml b/middle_end/closure/closure_middle_end.ml index cb593eb0ed9..0e1d6c5bcd7 100644 --- a/middle_end/closure/closure_middle_end.ml +++ b/middle_end/closure/closure_middle_end.ml @@ -35,14 +35,23 @@ let lambda_to_clambda ~backend ~filename:_ ~prefixname:_ ~ppf_dump Closure.intro ~backend ~size:lambda.main_module_block_size lambda.code in let provenance : Clambda.usymbol_provenance = + let current_unit_ident = + Compilation_unit.get_current_exn () + |> Compilation_unit.name + |> Compilation_unit.Name.persistent_ident + in { original_idents = []; - module_path = - Path.Pident (Ident.create_persistent (Compilenv.current_unit_name ())); + module_path = Path.Pident current_unit_ident; } in + let symbol = + Symbol.for_current_unit () + |> Symbol.linkage_name + |> Linkage_name.to_string + in let preallocated_block = Clambda.{ - symbol = Compilenv.make_symbol None; + symbol; exported = true; tag = 0; fields = List.init lambda.main_module_block_size (fun _ -> None); diff --git a/middle_end/compilation_unit.ml b/middle_end/compilation_unit.ml deleted file mode 100644 index 7fb48167bc4..00000000000 --- a/middle_end/compilation_unit.ml +++ /dev/null @@ -1,78 +0,0 @@ -(**************************************************************************) -(* *) -(* OCaml *) -(* *) -(* Pierre Chambart, OCamlPro *) -(* Mark Shinwell and Leo White, Jane Street Europe *) -(* *) -(* Copyright 2013--2016 OCamlPro SAS *) -(* Copyright 2014--2016 Jane Street Group LLC *) -(* *) -(* All rights reserved. This file is distributed under the terms of *) -(* the GNU Lesser General Public License version 2.1, with the *) -(* special exception on linking described in the file LICENSE. *) -(* *) -(**************************************************************************) - -[@@@ocaml.warning "+a-4-9-30-40-41-42-66"] -open! Int_replace_polymorphic_compare - -type t = { - id : Ident.t; - linkage_name : Linkage_name.t; - hash : int; -} - -let string_for_printing t = Ident.name t.id - -include Identifiable.Make (struct - type nonrec t = t - - (* Multiple units can have the same [id] if they come from different packs. - To distinguish these we also keep the linkage name, which contains the - name of the pack. *) - let compare v1 v2 = - if v1 == v2 then 0 - else - let c = compare v1.hash v2.hash in - if c = 0 then - let v1_id = Ident.name v1.id in - let v2_id = Ident.name v2.id in - let c = String.compare v1_id v2_id in - if c = 0 then - Linkage_name.compare v1.linkage_name v2.linkage_name - else - c - else c - - let equal x y = - if x == y then true - else compare x y = 0 - - let print ppf t = Format.pp_print_string ppf (string_for_printing t) - - let output oc x = output_string oc (Ident.name x.id) - let hash x = x.hash -end) - -let create (id : Ident.t) linkage_name = - if not (Ident.persistent id) then begin - Misc.fatal_error "Compilation_unit.create with non-persistent Ident.t" - end; - { id; linkage_name; hash = Hashtbl.hash (Ident.name id); } - -let get_persistent_ident cu = cu.id -let get_linkage_name cu = cu.linkage_name - -let current = ref None -let is_current arg = - match !current with - | None -> Misc.fatal_error "Current compilation unit is not set!" - | Some cur -> equal cur arg -let set_current t = current := Some t -let get_current () = !current -let get_current_exn () = - match !current with - | Some current -> current - | None -> Misc.fatal_error "Compilation_unit.get_current_exn" -let get_current_id_exn () = get_persistent_ident (get_current_exn ()) diff --git a/middle_end/compilenv.ml b/middle_end/compilenv.ml index 55cbadc68c1..01dae651ca0 100644 --- a/middle_end/compilenv.ml +++ b/middle_end/compilenv.ml @@ -24,17 +24,19 @@ open Config open Cmx_format +module CU = Compilation_unit + type error = Not_a_unit_info of string | Corrupted_unit_info of string - | Illegal_renaming of string * string * string + | Illegal_renaming of CU.Name.t * CU.Name.t * string exception Error of error let global_infos_table = - (Hashtbl.create 17 : (string, unit_infos option) Hashtbl.t) + (CU.Name.Tbl.create 17 : unit_infos option CU.Name.Tbl.t) let export_infos_table = - (Hashtbl.create 10 : (string, Export_info.t) Hashtbl.t) + (CU.Name.Tbl.create 10 : Export_info.t CU.Name.Tbl.t) let imported_sets_of_closures_table = (Set_of_closures_id.Tbl.create 10 @@ -77,8 +79,7 @@ let default_ui_export_info = Cmx_format.Clambda Value_unknown let current_unit = - { ui_name = ""; - ui_symbol = ""; + { ui_unit = CU.dummy; ui_defines = []; ui_imports_cmi = []; ui_imports_cmx = []; @@ -88,41 +89,12 @@ let current_unit = ui_force_link = false; ui_export_info = default_ui_export_info } -let symbolname_for_pack pack name = - match pack with - | None -> name - | Some p -> - let b = Buffer.create 64 in - for i = 0 to String.length p - 1 do - match p.[i] with - | '.' -> Buffer.add_string b "__" - | c -> Buffer.add_char b c - done; - Buffer.add_string b "__"; - Buffer.add_string b name; - Buffer.contents b - -let unit_id_from_name name = Ident.create_persistent name - -let concat_symbol unitname id = - unitname ^ "__" ^ id - -let make_symbol ?(unitname = current_unit.ui_symbol) idopt = - let prefix = "caml" ^ unitname in - match idopt with - | None -> prefix - | Some id -> concat_symbol prefix id - -let current_unit_linkage_name () = - Linkage_name.create (make_symbol ~unitname:current_unit.ui_symbol None) - -let reset ?packname name = - Hashtbl.clear global_infos_table; +let reset compilation_unit = + CU.Name.Tbl.clear global_infos_table; Set_of_closures_id.Tbl.clear imported_sets_of_closures_table; - let symbol = symbolname_for_pack packname name in - current_unit.ui_name <- name; - current_unit.ui_symbol <- symbol; - current_unit.ui_defines <- [symbol]; + CU.set_current compilation_unit; + current_unit.ui_unit <- compilation_unit; + current_unit.ui_defines <- [compilation_unit]; current_unit.ui_imports_cmi <- []; current_unit.ui_imports_cmx <- []; current_unit.ui_curry_fun <- []; @@ -133,29 +105,11 @@ let reset ?packname name = structured_constants := structured_constants_empty; current_unit.ui_export_info <- default_ui_export_info; merged_environment := Export_info.empty; - Hashtbl.clear export_infos_table; - let compilation_unit = - Compilation_unit.create - (Ident.create_persistent name) - (current_unit_linkage_name ()) - in - Compilation_unit.set_current compilation_unit + CU.Name.Tbl.clear export_infos_table let current_unit_infos () = current_unit -let current_unit_name () = - current_unit.ui_name - -let symbol_in_current_unit name = - let prefix = "caml" ^ current_unit.ui_symbol in - name = prefix || - (let lp = String.length prefix in - String.length name >= 2 + lp - && String.sub name 0 lp = prefix - && name.[lp] = '_' - && name.[lp + 1] = '_') - let read_unit_info filename = let ic = open_in_bin filename in try @@ -181,42 +135,46 @@ let read_library_info filename = close_in ic; infos - (* Read and cache info on global identifiers *) -let get_global_info global_ident = ( - let modname = Ident.name global_ident in - if modname = current_unit.ui_name then +let get_unit_info modname = + if CU.Name.equal modname (CU.name current_unit.ui_unit) + then Some current_unit else begin try - Hashtbl.find global_infos_table modname + CU.Name.Tbl.find global_infos_table modname with Not_found -> let (infos, crc) = - if Env.is_imported_opaque modname then (None, None) + if Env.is_imported_opaque (modname |> CU.Name.to_string) + then (None, None) else begin try let filename = - Load_path.find_uncap (modname ^ ".cmx") in + Load_path.find_uncap ((modname |> CU.Name.to_string) ^ ".cmx") in let (ui, crc) = read_unit_info filename in - if ui.ui_name <> modname then - raise(Error(Illegal_renaming(modname, ui.ui_name, filename))); + if not (CU.Name.equal (CU.name ui.ui_unit) modname) + then + raise(Error(Illegal_renaming(modname, CU.name ui.ui_unit, filename))); (Some ui, Some crc) with Not_found -> - let warn = Warnings.No_cmx_file modname in + let warn = Warnings.No_cmx_file (modname |> CU.Name.to_string) in Location.prerr_warning Location.none warn; (None, None) end in current_unit.ui_imports_cmx <- - (modname, crc) :: current_unit.ui_imports_cmx; - Hashtbl.add global_infos_table modname infos; + (modname |> CU.Name.to_string, crc) :: current_unit.ui_imports_cmx; + CU.Name.Tbl.add global_infos_table modname infos; infos end -) + +let get_global_info global_ident = + assert (Ident.is_global global_ident); + get_unit_info (global_ident |> Ident.name |> CU.Name.of_string) let cache_unit_info ui = - Hashtbl.add global_infos_table ui.ui_name (Some ui) + CU.Name.Tbl.add global_infos_table (CU.name ui.ui_unit) (Some ui) (* Return the approximation of a global identifier *) @@ -230,7 +188,8 @@ let toplevel_approx : (string, Clambda.value_approximation) Hashtbl.t = Hashtbl.create 16 let record_global_approx_toplevel () = - Hashtbl.add toplevel_approx current_unit.ui_name + Hashtbl.add toplevel_approx + (CU.Name.to_string (CU.name current_unit.ui_unit)) (get_clambda_approx current_unit) let global_approx id = @@ -241,48 +200,41 @@ let global_approx id = | None -> Clambda.Value_unknown | Some ui -> get_clambda_approx ui -(* Return the symbol used to refer to a global identifier *) +(* Determination of pack prefixes for units and identifiers *) -let symbol_for_global id = - if Ident.is_predef id then - "caml_exn_" ^ Ident.name id - else begin - let unitname = Ident.name id in - match - try ignore (Hashtbl.find toplevel_approx unitname); None - with Not_found -> get_global_info id - with - | None -> make_symbol ~unitname:(Ident.name id) None - | Some ui -> make_symbol ~unitname:ui.ui_symbol None - end +let pack_prefix_for_current_unit () = + CU.for_pack_prefix current_unit.ui_unit -(* Register the approximation of the module being compiled *) - -let unit_for_global id = - let sym_label = Linkage_name.create (symbol_for_global id) in - Compilation_unit.create id sym_label +let pack_prefix_for_global_ident id = + if not (Ident.is_global id) then + Misc.fatal_errorf "Identifier %a is not global" Ident.print id + else if Hashtbl.mem toplevel_approx (Ident.name id) then + CU.for_pack_prefix (CU.get_current_exn ()) + else + match get_global_info id with + | Some ui -> CU.for_pack_prefix ui.ui_unit + | None -> + (* If the .cmx file is missing, the prefix is assumed to be empty. *) + CU.Prefix.empty -let predefined_exception_compilation_unit = - Compilation_unit.create (Ident.create_persistent "__dummy__") - (Linkage_name.create "__dummy__") +let symbol_for_global' id = + assert (Ident.is_global_or_predef id); + let pack_prefix = + if Ident.is_global id then pack_prefix_for_global_ident id + else CU.Prefix.empty + in + Symbol.for_global_or_predef_ident pack_prefix id -let is_predefined_exception sym = - Compilation_unit.equal - predefined_exception_compilation_unit - (Symbol.compilation_unit sym) +let symbol_for_global id = + symbol_for_global' id |> Symbol.linkage_name -let symbol_for_global' id = - let sym_label = Linkage_name.create (symbol_for_global id) in - if Ident.is_predef id then - Symbol.of_global_linkage predefined_exception_compilation_unit sym_label - else - Symbol.of_global_linkage (unit_for_global id) sym_label +(* Register the approximation of the module being compiled *) let set_global_approx approx = assert(not Config.flambda); current_unit.ui_export_info <- Clambda approx -(* Exporting and importing cross module information *) +(* Exporting and importing cross module information (Flambda only) *) let get_flambda_export_info ui = assert(Config.flambda); @@ -294,23 +246,67 @@ let set_export_info export_info = assert(Config.flambda); current_unit.ui_export_info <- Flambda export_info +(* Determine which .cmx file to load for a given compilation unit. + This is tricky in the case of packs. It can be done by lining up the + desired compilation unit's full path (i.e. pack prefix then unit name) + against the current unit's full path and observing when/if they diverge. *) +let which_cmx_file desired_comp_unit = + let desired_prefix = CU.for_pack_prefix desired_comp_unit in + if CU.Prefix.is_empty desired_prefix then + (* If the unit we're looking for is not in a pack, then the correct .cmx + file is the one with the same name as the unit, irrespective of any + current pack. *) + CU.name desired_comp_unit + else + let current_comp_unit = Compilation_unit.get_current_exn () in + (* This lines up the full paths as described above. *) + let rec match_components ~current ~desired = + match current, desired with + | current_name::current, desired_name::desired -> + if CU.Name.equal current_name desired_name then + (* The full paths are equal up to the current point; keep going. *) + match_components ~current ~desired + else + (* The paths have diverged. The next component of the desired + path is the .cmx file to load. *) + desired_name + | [], desired_name::_desired -> + (* The whole of the current unit's full path (including the name of + the unit itself) is now known to be a prefix of the desired unit's + pack *prefix*. This means we must be making a pack. The .cmx + file to load is named after the next component of the desired + unit's path (which may in turn be a pack). *) + desired_name + | [], [] -> + (* The paths were equal, so the desired compilation unit is just the + current one. *) + CU.name desired_comp_unit + | _::_, [] -> + (* The current path is longer than the desired unit's path, which + means we're attempting to go back up the pack hierarchy. This is + an error. *) + Misc.fatal_errorf "Compilation unit@ %a@ is inaccessible when \ + compiling compilation unit@ %a" + CU.print desired_comp_unit + CU.print current_comp_unit + in + match_components ~current:(CU.full_path current_comp_unit) + ~desired:(CU.full_path desired_comp_unit) + let approx_for_global comp_unit = - let id = Compilation_unit.get_persistent_ident comp_unit in - if (Compilation_unit.equal - predefined_exception_compilation_unit - comp_unit) - || Ident.is_predef id - || not (Ident.global id) - then invalid_arg (Format.asprintf "approx_for_global %a" Ident.print id); - let modname = Ident.name id in - match Hashtbl.find export_infos_table modname with + if CU.equal comp_unit CU.predef_exn + then invalid_arg "approx_for_global with predef_exn compilation unit"; + let comp_unit_name = which_cmx_file comp_unit in + let id = Ident.create_persistent (comp_unit_name |> CU.Name.to_string) in + let modname = Ident.name id |> CU.Name.of_string in + match CU.Name.Tbl.find export_infos_table modname with | otherwise -> Some otherwise | exception Not_found -> match get_global_info id with | None -> None | Some ui -> let exported = get_flambda_export_info ui in - Hashtbl.add export_infos_table modname exported; + CU.Name.Tbl.add export_infos_table modname exported; merged_environment := Export_info.merge !merged_environment exported; Some exported @@ -346,23 +342,14 @@ let save_unit_info filename = current_unit.ui_imports_cmi <- Env.imports(); write_unit_info current_unit filename -let current_unit () = - match Compilation_unit.get_current () with - | Some current_unit -> current_unit - | None -> Misc.fatal_error "Compilenv.current_unit" - -let current_unit_symbol () = - Symbol.of_global_linkage (current_unit ()) (current_unit_linkage_name ()) - -let const_label = ref 0 - -let new_const_symbol () = - incr const_label; - make_symbol (Some (Int.to_string !const_label)) - let snapshot () = !structured_constants let backtrack s = structured_constants := s +let new_const_symbol () = + Symbol.for_new_const_in_current_unit () + |> Symbol.linkage_name + |> Linkage_name.to_string + let new_structured_constant cst ~shared = let {strcst_shared; strcst_all} = !structured_constants in if shared then @@ -398,7 +385,10 @@ let structured_constants () = let provenance : Clambda.usymbol_provenance = { original_idents = []; module_path = - Path.Pident (Ident.create_persistent (current_unit_name ())); + (* CR-someday lmaurer: Properly construct a [Path.t] from the module name + with its pack prefix. *) + Path.Pident (Ident.create_persistent (Compilation_unit.Name.to_string ( + Compilation_unit.name (Compilation_unit.get_current_exn ())))); } in SymMap.bindings (!structured_constants).strcst_all @@ -411,24 +401,6 @@ let structured_constants () = provenance = Some provenance; }) -let closure_symbol fv = - let compilation_unit = Closure_id.get_compilation_unit fv in - let unitname = - Linkage_name.to_string (Compilation_unit.get_linkage_name compilation_unit) - in - let linkage_name = - concat_symbol unitname ((Closure_id.unique_name fv) ^ "_closure") - in - Symbol.of_global_linkage compilation_unit (Linkage_name.create linkage_name) - -let function_label fv = - let compilation_unit = Closure_id.get_compilation_unit fv in - let unitname = - Linkage_name.to_string - (Compilation_unit.get_linkage_name compilation_unit) - in - (concat_symbol unitname (Closure_id.unique_name fv)) - let require_global global_ident = if not (Ident.is_predef global_ident) then ignore (get_global_info global_ident : Cmx_format.unit_infos option) @@ -446,8 +418,10 @@ let report_error ppf = function Location.print_filename filename | Illegal_renaming(name, modname, filename) -> fprintf ppf "%a@ contains the description for unit\ - @ %s when %s was expected" - Location.print_filename filename name modname + @ %a when %a was expected" + Location.print_filename filename + CU.Name.print name + CU.Name.print modname let () = Location.register_error_of_exn diff --git a/middle_end/compilenv.mli b/middle_end/compilenv.mli index 380b9c52f94..df4b60b530b 100644 --- a/middle_end/compilenv.mli +++ b/middle_end/compilenv.mli @@ -29,48 +29,21 @@ val imported_sets_of_closures_table : Simple_value_approx.function_declarations option Set_of_closures_id.Tbl.t (* flambda-only *) -val reset: ?packname:string -> string -> unit +val reset : Compilation_unit.t -> unit (* Reset the environment and record the name of the unit being - compiled (arg). Optional argument is [-for-pack] prefix. *) - -val unit_id_from_name: string -> Ident.t - (* flambda-only *) + compiled (including any associated -for-pack prefix). *) val current_unit_infos: unit -> unit_infos (* Return the infos for the unit being compiled *) -val current_unit_name: unit -> string - (* Return the name of the unit being compiled - clambda-only *) - -val current_unit_linkage_name: unit -> Linkage_name.t - (* Return the linkage_name of the unit being compiled. - flambda-only *) - -val current_unit: unit -> Compilation_unit.t - (* flambda-only *) - -val current_unit_symbol: unit -> Symbol.t - (* flambda-only *) - -val make_symbol: ?unitname:string -> string option -> string - (* [make_symbol ~unitname:u None] returns the asm symbol that - corresponds to the compilation unit [u] (default: the current unit). - [make_symbol ~unitname:u (Some id)] returns the asm symbol that - corresponds to symbol [id] in the compilation unit [u] - (or the current unit). *) - -val symbol_in_current_unit: string -> bool - (* Return true if the given asm symbol belongs to the - current compilation unit, false otherwise. *) - -val is_predefined_exception: Symbol.t -> bool - (* flambda-only *) +val pack_prefix_for_current_unit : unit -> Compilation_unit.Prefix.t + (* Return the pack prefix for the unit being compiled *) -val unit_for_global: Ident.t -> Compilation_unit.t - (* flambda-only *) +val pack_prefix_for_global_ident : Ident.t -> Compilation_unit.Prefix.t + (* Find the pack prefix for an identifier by reading the .cmx file. + The identifier must be [Global]. *) -val symbol_for_global: Ident.t -> string +val symbol_for_global: Ident.t -> Linkage_name.t (* Return the asm symbol that refers to the given global identifier flambda-only *) val symbol_for_global': Ident.t -> Symbol.t @@ -102,13 +75,6 @@ val need_send_fun: int -> Lambda.alloc_mode -> unit message sending) function with the given arity *) val new_const_symbol : unit -> string -val closure_symbol : Closure_id.t -> Symbol.t - (* Symbol of a function if the function is - closed (statically allocated) - flambda-only *) -val function_label : Closure_id.t -> string - (* linkage name of the code of a function - flambda-only *) val new_structured_constant: Clambda.ustructured_constant -> @@ -150,7 +116,8 @@ val read_library_info: string -> library_infos type error = Not_a_unit_info of string | Corrupted_unit_info of string - | Illegal_renaming of string * string * string + | Illegal_renaming of + Compilation_unit.Name.t * Compilation_unit.Name.t * string exception Error of error diff --git a/middle_end/flambda/build_export_info.ml b/middle_end/flambda/build_export_info.ml index 32b82535e39..a529a52d3c3 100644 --- a/middle_end/flambda/build_export_info.ml +++ b/middle_end/flambda/build_export_info.ml @@ -57,7 +57,7 @@ module Env : sig export descriptions with the given global environment. *) val empty_of_global : symbols_being_defined:Symbol.Set.t -> Global.t -> t end = struct - let fresh_id () = Export_id.create (Compilenv.current_unit ()) + let fresh_id () = Export_id.create (Compilation_unit.get_current_exn ()) module Global = struct type t = @@ -114,7 +114,7 @@ end = struct with Not_found -> None let extern_symbol_descr sym = - if Compilenv.is_predefined_exception sym + if Symbol.is_predef_exn sym then None else match @@ -531,11 +531,10 @@ let describe_program (env : Env.Global.t) (program : Flambda.program) = loop env program.program_body -let build_transient ~(backend : (module Backend_intf.S)) - (program : Flambda.program) : Export_info.transient = +let build_transient (program : Flambda.program) : Export_info.transient = if !Clflags.opaque then - let compilation_unit = Compilenv.current_unit () in - let root_symbol = Compilenv.current_unit_symbol () in + let compilation_unit = Compilation_unit.get_current_exn () in + let root_symbol = Symbol.for_current_unit () in Export_info.opaque_transient ~root_symbol ~compilation_unit else (* CR-soon pchambart: Should probably use that instead of the ident of @@ -553,8 +552,7 @@ let build_transient ~(backend : (module Backend_intf.S)) let set_of_closures_approx { Flambda. function_decls; _ } = let recursive = lazy - (Find_recursive_functions.in_function_declarations - function_decls ~backend) + (Find_recursive_functions.in_function_declarations function_decls) in let keep_body = Inline_and_simplify_aux.keep_body_check @@ -575,8 +573,7 @@ let build_transient ~(backend : (module Backend_intf.S)) if function_decls.is_classic_mode then begin Variable.Map.empty end else begin - Invariant_params.invariant_params_in_recursion - ~backend function_decls + Invariant_params.invariant_params_in_recursion function_decls end) (Flambda_utils.all_sets_of_closures_map program) in @@ -616,8 +613,7 @@ let build_transient ~(backend : (module Backend_intf.S)) if function_decls.is_classic_mode then begin Variable.Set.empty end else begin - Find_recursive_functions.in_function_declarations - ~backend function_decls + Find_recursive_functions.in_function_declarations function_decls end) (Flambda_utils.all_sets_of_closures_map program) in @@ -681,9 +677,10 @@ let build_transient ~(backend : (module Backend_intf.S)) ~sets_of_closures_map ~closure_id_to_set_of_closures_id ~function_declarations_map - ~values:(Compilation_unit.Map.find (Compilenv.current_unit ()) values) + ~values:(Compilation_unit.Map.find + (Compilation_unit.get_current_exn ()) values) ~symbol_id - ~root_symbol:(Compilenv.current_unit_symbol ()) + ~root_symbol:(Symbol.for_current_unit ()) in let sets_of_closures = function_declarations_map |> Set_of_closures_id.Map.filter_map diff --git a/middle_end/flambda/build_export_info.mli b/middle_end/flambda/build_export_info.mli index 0380604bf88..da35bf05c64 100644 --- a/middle_end/flambda/build_export_info.mli +++ b/middle_end/flambda/build_export_info.mli @@ -20,6 +20,5 @@ Flambda program. *) val build_transient : - backend:(module Backend_intf.S) -> Flambda.program -> Export_info.transient diff --git a/middle_end/flambda/closure_conversion.ml b/middle_end/flambda/closure_conversion.ml index f4b3aac6fd1..82b0c30bd57 100644 --- a/middle_end/flambda/closure_conversion.ml +++ b/middle_end/flambda/closure_conversion.ml @@ -27,13 +27,16 @@ let name_expr_from_var = Flambda_utils.name_expr_from_var type t = { current_unit_id : Ident.t; - symbol_for_global' : (Ident.t -> Symbol.t); filename : string; backend : (module Backend_intf.S); mutable imported_symbols : Symbol.Set.t; mutable declared_symbols : (Symbol.t * Flambda.constant_defining_value) list; } +let pack_prefix_for_global_ident t = + let module B = (val t.backend : Backend_intf.S) in + B.pack_prefix_for_global_ident + let add_default_argument_wrappers lam = let defs_are_all_functions (defs : (_ * Lambda.lambda) list) = List.for_all (function (_, Lambda.Lfunction _) -> true | _ -> false) defs @@ -113,7 +116,7 @@ let tupled_function_call_stub original_params unboxed_version ~closure_bound_var let register_const t (constant:Flambda.constant_defining_value) name : Flambda.constant_defining_value_block_field * Internal_variable_names.t = let var = Variable.create name in - let symbol = Symbol.of_variable var in + let symbol = Symbol_utils.Flambda.for_variable var in t.declared_symbols <- (symbol, constant) :: t.declared_symbols; Symbol symbol, name @@ -349,9 +352,7 @@ let rec close t env (lam : Lambda.lambda) : Flambda.t = let zero = Variable.create Names.zero in let is_zero = Variable.create Names.is_zero in let exn = Variable.create Names.division_by_zero in - let exn_symbol = - t.symbol_for_global' Predef.ident_division_by_zero - in + let exn_symbol = Symbol.for_predef_ident Predef.ident_division_by_zero in let dbg = Debuginfo.from_location loc in let zero_const : Flambda.named = match prim with @@ -482,12 +483,14 @@ let rec close t env (lam : Lambda.lambda) : Flambda.t = Misc.fatal_errorf "[Psetfield (Pgetglobal ...)] is \ forbidden upon entry to the middle end" | Lprim (Pgetglobal id, [], _) when Ident.is_predef id -> - let symbol = t.symbol_for_global' id in + let symbol = Symbol.for_predef_ident id in t.imported_symbols <- Symbol.Set.add symbol t.imported_symbols; name_expr (Symbol symbol) ~name:Names.predef_exn | Lprim (Pgetglobal id, [], _) -> assert (not (Ident.same id t.current_unit_id)); - let symbol = t.symbol_for_global' id in + let symbol = + Symbol.for_global_or_predef_ident ((pack_prefix_for_global_ident t) id) id + in t.imported_symbols <- Symbol.Set.add symbol t.imported_symbols; name_expr (Symbol symbol) ~name:Names.pgetglobal | Lprim (lambda_p, args, loc) -> @@ -720,21 +723,27 @@ and close_let_bound_expression t ?let_rec_ident let_bound_var env let lambda_to_flambda ~backend ~module_ident ~size ~filename lam : Flambda.program = let lam = add_default_argument_wrappers lam in - let module Backend = (val backend : Backend_intf.S) in let compilation_unit = Compilation_unit.get_current_exn () in + let current_unit_id = + Compilation_unit.name compilation_unit + |> Compilation_unit.Name.to_string + |> Ident.create_persistent + in let t = - { current_unit_id = Compilation_unit.get_persistent_ident compilation_unit; - symbol_for_global' = Backend.symbol_for_global'; + { current_unit_id; filename; backend; imported_symbols = Symbol.Set.empty; declared_symbols = []; } in - let module_symbol = Backend.symbol_for_global' module_ident in + let module_symbol = + let pack_prefix = Compilation_unit.Prefix.from_clflags () in + Symbol.for_global_or_predef_ident pack_prefix module_ident + in let block_symbol = let var = Variable.create Internal_variable_names.module_as_block in - Symbol.of_variable var + Symbol_utils.Flambda.for_variable var in (* The global module block is built by accessing the fields of all the introduced symbols. *) diff --git a/middle_end/flambda/export_info_for_pack.ml b/middle_end/flambda/export_info_for_pack.ml index 6fc8172aec6..5f889325a4a 100644 --- a/middle_end/flambda/export_info_for_pack.ml +++ b/middle_end/flambda/export_info_for_pack.ml @@ -26,13 +26,17 @@ let imported_function_declarations_table = (* Rename export identifiers' compilation units to denote that they now live within a pack. *) -let import_eid_for_pack units pack id = +let import_eid_for_pack units prefix id = try Export_id.Tbl.find rename_id_state id with Not_found -> let unit_id = Export_id.get_compilation_unit id in let id' = if Compilation_unit.Set.mem unit_id units - then Export_id.create ?name:(Export_id.name id) pack + then + let compilation_unit = + Compilation_unit.with_for_pack_prefix unit_id prefix + in + Export_id.create ?name:(Export_id.name id) compilation_unit else id in Export_id.Tbl.add rename_id_state id id'; @@ -52,19 +56,22 @@ let import_approx_for_pack units pack (approx : Export_info.approx) | Value_id eid -> Value_id (import_eid_for_pack units pack eid) | Value_unknown -> Value_unknown -let import_set_of_closures_id_for_pack units pack +let import_set_of_closures_id_for_pack units prefix (set_of_closures_id : Set_of_closures_id.t) : Set_of_closures_id.t = let compilation_unit = Set_of_closures_id.get_compilation_unit set_of_closures_id in if Compilation_unit.Set.mem compilation_unit units then + let compilation_unit = + Compilation_unit.with_for_pack_prefix compilation_unit prefix + in Set_of_closures_id.Tbl.memoize rename_set_of_closures_id_state (fun _ -> Set_of_closures_id.create ?name:(Set_of_closures_id.name set_of_closures_id) - pack) + compilation_unit) set_of_closures_id else set_of_closures_id diff --git a/middle_end/flambda/export_info_for_pack.mli b/middle_end/flambda/export_info_for_pack.mli index 2ba3a35d8b2..c1dbfb7015f 100644 --- a/middle_end/flambda/export_info_for_pack.mli +++ b/middle_end/flambda/export_info_for_pack.mli @@ -26,7 +26,7 @@ [pack] instead. *) val import_for_pack : pack_units:Compilation_unit.Set.t - -> pack:Compilation_unit.t + -> pack:Compilation_unit.Prefix.t -> Export_info.t -> Export_info.t diff --git a/middle_end/flambda/find_recursive_functions.ml b/middle_end/flambda/find_recursive_functions.ml index e69433039fc..90e3cb6e01b 100644 --- a/middle_end/flambda/find_recursive_functions.ml +++ b/middle_end/flambda/find_recursive_functions.ml @@ -17,13 +17,10 @@ [@@@ocaml.warning "+a-4-9-30-40-41-42-66"] open! Int_replace_polymorphic_compare -let in_function_declarations (function_decls : Flambda.function_declarations) - ~backend = +let in_function_declarations (function_decls : Flambda.function_declarations) = let module VCC = Strongly_connected_components.Make (Variable) in let directed_graph = - let module B = (val backend : Backend_intf.S) in Flambda_utils.fun_vars_referenced_in_decls function_decls - ~closure_symbol:B.closure_symbol in let connected_components = VCC.connected_components_sorted_from_roots_to_leaf directed_graph diff --git a/middle_end/flambda/find_recursive_functions.mli b/middle_end/flambda/find_recursive_functions.mli index 3c2dd5b1fbf..3db43041c9a 100644 --- a/middle_end/flambda/find_recursive_functions.mli +++ b/middle_end/flambda/find_recursive_functions.mli @@ -33,5 +33,4 @@ *) val in_function_declarations : Flambda.function_declarations - -> backend:(module Backend_intf.S) -> Variable.Set.t diff --git a/middle_end/flambda/flambda_middle_end.ml b/middle_end/flambda/flambda_middle_end.ml index 31f0a6d9e7e..428131861a0 100644 --- a/middle_end/flambda/flambda_middle_end.ml +++ b/middle_end/flambda/flambda_middle_end.ml @@ -17,15 +17,14 @@ [@@@ocaml.warning "+a-4-30-40-41-42-66"] open! Int_replace_polymorphic_compare -let _dump_function_sizes flam ~backend = - let module Backend = (val backend : Backend_intf.S) in +let _dump_function_sizes flam = let than = max_int in Flambda_iterators.iter_on_set_of_closures_of_program flam ~f:(fun ~constant:_ (set_of_closures : Flambda.set_of_closures) -> Variable.Map.iter (fun fun_var (function_decl : Flambda.function_declaration) -> let closure_id = Closure_id.wrap fun_var in - let symbol = Backend.closure_symbol closure_id in + let symbol = Symbol_utils.Flambda.for_closure closure_id in match Inlining_cost.lambda_smaller' function_decl.body ~than with | Some size -> Format.eprintf "%a %d\n" Symbol.print symbol size | None -> assert false) @@ -221,7 +220,7 @@ let lambda_to_clambda ~backend ~filename ~prefixname ~ppf_dump ~module_ident:program.module_ident ~module_initializer:program.code in - let export = Build_export_info.build_transient ~backend program in + let export = Build_export_info.build_transient program in let clambda, preallocated_blocks, constants = Profile.record_call "backend" (fun () -> (program, export) @@ -231,14 +230,15 @@ let lambda_to_clambda ~backend ~filename ~prefixname ~ppf_dump structured_constants; exported; } -> Compilenv.set_export_info exported; let clambda = - Un_anf.apply ~what:(Compilenv.current_unit_symbol ()) + Un_anf.apply ~what:(Symbol.for_current_unit ()) ~ppf_dump expr in clambda, preallocated_blocks, structured_constants)) in let constants = List.map (fun (symbol, definition) -> - { Clambda.symbol = Linkage_name.to_string (Symbol.label symbol); + { Clambda. + symbol = Symbol.linkage_name symbol |> Linkage_name.to_string; exported = true; definition; provenance = None; diff --git a/middle_end/flambda/flambda_to_clambda.ml b/middle_end/flambda/flambda_to_clambda.ml index db9693f59ad..a5753b73ebe 100644 --- a/middle_end/flambda/flambda_to_clambda.ml +++ b/middle_end/flambda/flambda_to_clambda.ml @@ -38,7 +38,8 @@ type t = { let get_fun_offset t closure_id = let fun_offset_table = - if Closure_id.in_compilation_unit closure_id (Compilenv.current_unit ()) + if Closure_id.in_compilation_unit closure_id + (Compilation_unit.get_current_exn ()) then t.current_unit.fun_offset_table else @@ -52,7 +53,7 @@ let get_fun_offset t closure_id = let get_fv_offset t var_within_closure = let fv_offset_table = if Var_within_closure.in_compilation_unit var_within_closure - (Compilenv.current_unit ()) + (Compilation_unit.get_current_exn ()) then t.current_unit.fv_offset_table else t.imported_units.fv_offset_table in @@ -81,14 +82,11 @@ let check_closure t ulam named : Clambda.ulambda = ~arity:2 ~alloc:false in let str = Format.asprintf "%a" Flambda.print_named named in - let sym = Compilenv.new_const_symbol () in - let sym' = - Symbol.of_global_linkage (Compilation_unit.get_current_exn ()) - (Linkage_name.create sym) - in + let sym = Symbol.for_new_const_in_current_unit () in t.constants_for_instrumentation <- - Symbol.Map.add sym' (Clambda.Uconst_string str) + Symbol.Map.add sym (Clambda.Uconst_string str) t.constants_for_instrumentation; + let sym = Symbol.linkage_name sym |> Linkage_name.to_string in Uprim (Pccall desc, [ulam; Clambda.Uconst (Uconst_ref (sym, None))], Debuginfo.none) @@ -113,16 +111,13 @@ let check_field t ulam pos named_opt : Clambda.ulambda = | None -> "" | Some named -> Format.asprintf "%a" Flambda.print_named named in - let sym = Compilenv.new_const_symbol () in - let sym' = - Symbol.of_global_linkage (Compilation_unit.get_current_exn ()) - (Linkage_name.create sym) - in + let sym = Symbol.for_new_const_in_current_unit () in t.constants_for_instrumentation <- - Symbol.Map.add sym' (Clambda.Uconst_string str) + Symbol.Map.add sym (Clambda.Uconst_string str) t.constants_for_instrumentation; + let sym = Symbol.linkage_name sym in Uprim (Pccall desc, [ulam; Clambda.Uconst (Uconst_int pos); - Clambda.Uconst (Uconst_ref (sym, None))], + Clambda.Uconst (Uconst_ref (sym |> Linkage_name.to_string, None))], Debuginfo.none) module Env : sig @@ -228,7 +223,7 @@ let to_uconst_symbol env symbol : Clambda.ustructured_constant option = | Some _ -> None let to_clambda_symbol' env sym : Clambda.uconstant = - let lbl = Linkage_name.to_string (Symbol.label sym) in + let lbl = Symbol.linkage_name sym |> Linkage_name.to_string in Uconst_ref (lbl, to_uconst_symbol env sym) let to_clambda_symbol env sym : Clambda.ulambda = @@ -476,7 +471,11 @@ and to_clambda_switch t env cases num_keys default = and to_clambda_direct_apply t func args direct_func probe dbg pos mode env : Clambda.ulambda = let closed = is_function_constant t direct_func in - let label = Compilenv.function_label direct_func in + let label = + Symbol_utils.Flambda.for_code_of_closure direct_func + |> Symbol.linkage_name + |> Linkage_name.to_string + in let uargs = let uargs = subst_vars env args in (* Remove the closure argument if the closure is closed. (Note that the @@ -566,7 +565,12 @@ and to_clambda_set_of_closures t env env, id :: params) function_decl.params (env, []) in - { label = Compilenv.function_label closure_id; + let label = + Symbol_utils.Flambda.for_code_of_closure closure_id + |> Symbol.linkage_name + |> Linkage_name.to_string + in + { label; arity = clambda_arity function_decl; params = List.map @@ -600,7 +604,7 @@ and to_clambda_closed_set_of_closures t env symbol let env = List.fold_left (fun env (var, _) -> let closure_id = Closure_id.wrap var in - let symbol = Compilenv.closure_symbol closure_id in + let symbol = Symbol_utils.Flambda.for_closure closure_id in Env.add_subst env var (to_clambda_symbol env symbol)) (Env.keep_only_symbols env) functions @@ -615,7 +619,12 @@ and to_clambda_closed_set_of_closures t env symbol Un_anf.apply ~ppf_dump:t.ppf_dump ~what:symbol (to_clambda t env_body function_decl.body) in - { label = Compilenv.function_label (Closure_id.wrap id); + let label = + Symbol_utils.Flambda.for_code_of_closure (Closure_id.wrap id) + |> Symbol.linkage_name + |> Linkage_name.to_string + in + { label; arity = clambda_arity function_decl; params = List.map (fun var -> VP.create var, Lambda.Pgenval) params; return = Lambda.Pgenval; @@ -626,7 +635,7 @@ and to_clambda_closed_set_of_closures t env symbol } in let ufunct = List.map to_clambda_function functions in - let closure_lbl = Linkage_name.to_string (Symbol.label symbol) in + let closure_lbl = Symbol.linkage_name symbol |> Linkage_name.to_string in Uconst_closure (ufunct, closure_lbl, []) let to_clambda_initialize_symbol t env symbol fields : Clambda.ulambda = @@ -713,13 +722,13 @@ let to_clambda_program t env constants (program : Flambda.program) = in Some (Clambda.Uconst_field_int n) | Some (Flambda.Symbol sym) -> - let lbl = Linkage_name.to_string (Symbol.label sym) in + let lbl = Symbol.linkage_name sym |> Linkage_name.to_string in Some (Clambda.Uconst_field_ref lbl)) fields in let e1 = to_clambda_initialize_symbol t env symbol init_fields in let preallocated_block : Clambda.preallocated_block = - { symbol = Linkage_name.to_string (Symbol.label symbol); + { symbol = Symbol.linkage_name symbol |> Linkage_name.to_string; exported = true; tag = Tag.to_int tag; fields = constant_fields; diff --git a/middle_end/flambda/flambda_utils.ml b/middle_end/flambda/flambda_utils.ml index 059d463cb74..a892521c853 100644 --- a/middle_end/flambda/flambda_utils.ml +++ b/middle_end/flambda/flambda_utils.ml @@ -827,12 +827,12 @@ module Switch_storer = Switch.Store (struct end) let fun_vars_referenced_in_decls - (function_decls : Flambda.function_declarations) ~closure_symbol = + (function_decls : Flambda.function_declarations) = let fun_vars = Variable.Map.keys function_decls.funs in let symbols_to_fun_vars = Variable.Set.fold (fun fun_var symbols_to_fun_vars -> let closure_id = Closure_id.wrap fun_var in - let symbol = closure_symbol closure_id in + let symbol = Symbol_utils.Flambda.for_closure closure_id in Symbol.Map.add symbol fun_var symbols_to_fun_vars) fun_vars Symbol.Map.empty @@ -855,9 +855,9 @@ let fun_vars_referenced_in_decls function_decls.funs let closures_required_by_entry_point ~(entry_point : Closure_id.t) - ~closure_symbol (function_decls : Flambda.function_declarations) = + (function_decls : Flambda.function_declarations) = let dependencies = - fun_vars_referenced_in_decls function_decls ~closure_symbol + fun_vars_referenced_in_decls function_decls in let set = ref Variable.Set.empty in let queue = Queue.create () in diff --git a/middle_end/flambda/flambda_utils.mli b/middle_end/flambda/flambda_utils.mli index 0f6e6ba7d43..49bfeeab1b7 100644 --- a/middle_end/flambda/flambda_utils.mli +++ b/middle_end/flambda/flambda_utils.mli @@ -180,14 +180,12 @@ end *) val fun_vars_referenced_in_decls : Flambda.function_declarations - -> closure_symbol:(Closure_id.t -> Symbol.t) -> Variable.Set.t Variable.Map.t (** Computes the set of closure_id in the set of closures that are required used (transitively) the entry_point *) val closures_required_by_entry_point : entry_point:Closure_id.t - -> closure_symbol:(Closure_id.t -> Symbol.t) -> Flambda.function_declarations -> Variable.Set.t diff --git a/middle_end/flambda/freshening.ml b/middle_end/flambda/freshening.ml index c84813276b8..a3c83ae35f5 100644 --- a/middle_end/flambda/freshening.ml +++ b/middle_end/flambda/freshening.ml @@ -196,8 +196,7 @@ let apply_mutable_variable t mut_var = | Not_found -> mut_var let rewrite_recursive_calls_with_symbols t - (function_declarations : Flambda.function_declarations) - ~make_closure_symbol = + (function_declarations : Flambda.function_declarations) = match t with | Inactive -> function_declarations | Active _ -> @@ -212,7 +211,7 @@ let rewrite_recursive_calls_with_symbols t let closure_symbols = Variable.Map.fold (fun var _ map -> let closure_id = Closure_id.wrap var in - let sym = make_closure_symbol closure_id in + let sym = Symbol_utils.Flambda.for_closure closure_id in if Symbol.Set.mem sym all_free_symbols then begin closure_symbols_used := true; Symbol.Map.add sym var map diff --git a/middle_end/flambda/freshening.mli b/middle_end/flambda/freshening.mli index 1550797ac1c..9ccde4f2120 100644 --- a/middle_end/flambda/freshening.mli +++ b/middle_end/flambda/freshening.mli @@ -87,7 +87,6 @@ val apply_static_exception : t -> Static_exception.t -> Static_exception.t val rewrite_recursive_calls_with_symbols : t -> Flambda.function_declarations - -> make_closure_symbol:(Closure_id.t -> Symbol.t) -> Flambda.function_declarations (* CR-soon mshinwell for mshinwell: maybe inaccurate module name, it freshens diff --git a/middle_end/flambda/import_approx.ml b/middle_end/flambda/import_approx.ml index f5c004aa6bb..2f9652af05d 100644 --- a/middle_end/flambda/import_approx.ml +++ b/middle_end/flambda/import_approx.ml @@ -26,7 +26,7 @@ let import_set_of_closures = let sym_to_fun_var_map (clos : A.function_declarations) = Variable.Map.fold (fun fun_var _ acc -> let closure_id = Closure_id.wrap fun_var in - let sym = Compilenv.closure_symbol closure_id in + let sym = Symbol_utils.Flambda.for_closure closure_id in Symbol.Map.add sym fun_var acc) clos.funs Symbol.Map.empty in @@ -185,7 +185,7 @@ and import_approx (ap : Export_info.approx) = | Value_symbol sym -> A.value_symbol sym let import_symbol sym = - if Compilenv.is_predefined_exception sym then + if Symbol.is_predef_exn sym then A.value_unknown Other else begin let compilation_unit = Symbol.compilation_unit sym in @@ -196,9 +196,10 @@ let import_symbol sym = | approx -> A.augment_with_symbol (import_ex approx) sym | exception Not_found -> Misc.fatal_errorf - "Compilation unit = %a Cannot find symbol %a" + "Compilation unit = %a Cannot find symbol %a, all known:@ %a" Compilation_unit.print compilation_unit Symbol.print sym + (Symbol.Map.print Export_id.print) export_info.symbol_id end (* Note for code reviewers: Observe that [really_import] iterates until diff --git a/middle_end/flambda/inline_and_simplify.ml b/middle_end/flambda/inline_and_simplify.ml index 96c282b17df..a718d3cd3b0 100644 --- a/middle_end/flambda/inline_and_simplify.ml +++ b/middle_end/flambda/inline_and_simplify.ml @@ -575,14 +575,12 @@ and simplify_set_of_closures original_env r (set_of_closures : Flambda.set_of_closures) : Flambda.set_of_closures * R.t * Freshening.Project_var.t = let function_decls = - let module Backend = (val (E.backend original_env) : Backend_intf.S) in (* CR-soon mshinwell: Does this affect [reference_recursive_function_directly]? mshinwell: This should be thought about as part of the wider issue of references to functions via symbols or variables. *) Freshening.rewrite_recursive_calls_with_symbols (E.freshening original_env) set_of_closures.function_decls - ~make_closure_symbol:Backend.closure_symbol in let env = E.increase_closure_depth original_env in let free_vars, specialised_args, function_decls, parameter_approximations, @@ -630,12 +628,10 @@ and simplify_set_of_closures original_env r Flambda.update_function_declarations function_decls ~funs in let invariant_params = - lazy (Invariant_params.invariant_params_in_recursion function_decls - ~backend:(E.backend env)) + lazy (Invariant_params.invariant_params_in_recursion function_decls) in let recursive = - lazy (Find_recursive_functions.in_function_declarations function_decls - ~backend:(E.backend env)) + lazy (Find_recursive_functions.in_function_declarations function_decls) in let keep_body = Inline_and_simplify_aux.keep_body_check @@ -947,7 +943,6 @@ and simplify_named env r (tree : Flambda.named) : Flambda.named * R.t = simplify_named_using_approx_and_env env r tree approx end | Set_of_closures set_of_closures -> begin - let backend = E.backend env in let r = match set_of_closures.alloc_mode with | Alloc_local -> R.set_region_use r true @@ -1024,7 +1019,7 @@ and simplify_named env r (tree : Flambda.named) : Flambda.named * R.t = match Remove_unused_arguments. separate_unused_arguments_in_set_of_closures - set_of_closures ~backend + set_of_closures with | Some set_of_closures -> let expr = @@ -1532,12 +1527,10 @@ let constant_defining_value_approx assert(Variable.Map.is_empty free_vars); assert(Variable.Map.is_empty specialised_args); let invariant_params = - lazy (Invariant_params.invariant_params_in_recursion function_decls - ~backend:(E.backend env)) + lazy (Invariant_params.invariant_params_in_recursion function_decls) in let recursive = - lazy (Find_recursive_functions.in_function_declarations function_decls - ~backend:(E.backend env)) + lazy (Find_recursive_functions.in_function_declarations function_decls) in let value_set_of_closures = let keep_body = @@ -1733,11 +1726,10 @@ let simplify_program env r (program : Flambda.program) = let program = { program with program_body; } in program, r -let add_predef_exns_to_environment ~env ~backend = - let module Backend = (val backend : Backend_intf.S) in +let add_predef_exns_to_environment ~env = List.fold_left (fun env predef_exn -> assert (Ident.is_predef predef_exn); - let symbol = Backend.symbol_for_global' predef_exn in + let symbol = Symbol.for_predef_ident predef_exn in let name = Ident.name predef_exn in let approx = A.value_block Tag.object_tag @@ -1756,7 +1748,6 @@ let run ~never_inline ~backend ~prefixname ~round ~ppf_dump program = let initial_env = add_predef_exns_to_environment ~env:(E.create ~never_inline ~backend ~round ~ppf_dump) - ~backend in let result, r = simplify_program initial_env r program in let result = Flambda_utils.introduce_needed_import_symbols result in diff --git a/middle_end/flambda/invariant_params.ml b/middle_end/flambda/invariant_params.ml index a43cfdace1e..979ec1418cc 100644 --- a/middle_end/flambda/invariant_params.ml +++ b/middle_end/flambda/invariant_params.ml @@ -124,14 +124,12 @@ let transitive_closure state = the association [g -> f] *) let function_variable_alias - (function_decls : Flambda.function_declarations) - ~backend = + (function_decls : Flambda.function_declarations) = let fun_vars = Variable.Map.keys function_decls.funs in let symbols_to_fun_vars = - let module Backend = (val backend : Backend_intf.S) in Variable.Set.fold (fun fun_var symbols_to_fun_vars -> let closure_id = Closure_id.wrap fun_var in - let symbol = Backend.closure_symbol closure_id in + let symbol = Symbol_utils.Flambda.for_closure closure_id in Symbol.Map.add symbol fun_var symbols_to_fun_vars) fun_vars Symbol.Map.empty @@ -156,10 +154,10 @@ let function_variable_alias function_decls.funs; !fun_var_bindings -let analyse_functions ~backend ~param_to_param +let analyse_functions ~param_to_param ~anything_to_param ~param_to_anywhere (decls : Flambda.function_declarations) = - let function_variable_alias = function_variable_alias ~backend decls in + let function_variable_alias = function_variable_alias decls in let param_indexes_by_fun_vars = Variable.Map.map (fun (decl : Flambda.function_declaration) -> Array.of_list (Parameter.List.vars decl.params)) @@ -307,8 +305,7 @@ let analyse_functions ~backend ~param_to_param *) -let invariant_params_in_recursion (decls : Flambda.function_declarations) - ~backend = +let invariant_params_in_recursion (decls : Flambda.function_declarations) = let param_to_param ~caller ~caller_arg ~callee ~callee_arg relation = implies relation (caller, caller_arg) (callee, callee_arg) in @@ -317,7 +314,7 @@ let invariant_params_in_recursion (decls : Flambda.function_declarations) in let param_to_anywhere ~caller:_ ~caller_arg:_ relation = relation in let relation = - analyse_functions ~backend ~param_to_param + analyse_functions ~param_to_param ~anything_to_param ~param_to_anywhere decls in @@ -368,14 +365,14 @@ let invariant_params_in_recursion (decls : Flambda.function_declarations) | set -> set) unchanging -let invariant_param_sources decls ~backend = +let invariant_param_sources decls = let param_to_param ~caller ~caller_arg ~callee ~callee_arg relation = implies relation (caller, caller_arg) (callee, callee_arg) in let anything_to_param ~callee:_ ~callee_arg:_ relation = relation in let param_to_anywhere ~caller:_ ~caller_arg:_ relation = relation in let relation = - analyse_functions ~backend ~param_to_param + analyse_functions ~param_to_param ~anything_to_param ~param_to_anywhere decls in @@ -388,7 +385,7 @@ let invariant_param_sources decls ~backend = let pass_name = "unused-arguments" let () = Clflags.all_passes := pass_name :: !Clflags.all_passes -let unused_arguments (decls : Flambda.function_declarations) ~backend = +let unused_arguments (decls : Flambda.function_declarations) = let dump = Clflags.dumped_pass pass_name in let param_to_param ~caller ~caller_arg ~callee ~callee_arg relation = implies relation (callee, callee_arg) (caller, caller_arg) @@ -398,7 +395,7 @@ let unused_arguments (decls : Flambda.function_declarations) ~backend = top relation (caller, caller_arg) in let relation = - analyse_functions ~backend ~param_to_param + analyse_functions ~param_to_param ~anything_to_param ~param_to_anywhere decls in diff --git a/middle_end/flambda/invariant_params.mli b/middle_end/flambda/invariant_params.mli index c68514203cf..8872bfa1ea5 100644 --- a/middle_end/flambda/invariant_params.mli +++ b/middle_end/flambda/invariant_params.mli @@ -41,17 +41,14 @@ *) val invariant_params_in_recursion : Flambda.function_declarations - -> backend:(module Backend_intf.S) -> Variable.Set.t Variable.Map.t val invariant_param_sources : Flambda.function_declarations - -> backend:(module Backend_intf.S) -> Variable.Pair.Set.t Variable.Map.t (* CR-soon mshinwell: think about whether this function should be in this file. Should it be called "unused_parameters"? *) val unused_arguments : Flambda.function_declarations - -> backend:(module Backend_intf.S) -> Variable.Set.t diff --git a/middle_end/flambda/lift_constants.ml b/middle_end/flambda/lift_constants.ml index b383517b9b6..54b96a5292b 100644 --- a/middle_end/flambda/lift_constants.ml +++ b/middle_end/flambda/lift_constants.ml @@ -25,15 +25,10 @@ let rec tail_variable : Flambda.t -> Variable.t option = function | Let { body = e; _ } -> tail_variable e | _ -> None -let closure_symbol ~(backend : (module Backend_intf.S)) closure_id = - let module Backend = (val backend) in - Backend.closure_symbol closure_id - (** Traverse the given expression assigning symbols to [let]- and [let rec]- bound constant variables. At the same time collect the definitions of such variables. *) let assign_symbols_and_collect_constant_definitions - ~(backend : (module Backend_intf.S)) ~(program : Flambda.program) ~(inconstants : Inconstant_idents.result) = let var_to_symbol_tbl = Variable.Tbl.create 42 in @@ -42,7 +37,7 @@ let assign_symbols_and_collect_constant_definitions let assign_symbol var (named : Flambda.named) = if not (Inconstant_idents.variable var inconstants) then begin let assign_symbol () = - let symbol = Symbol.of_variable (Variable.rename var) in + let symbol = Symbol_utils.Flambda.for_variable (Variable.rename var) in Variable.Tbl.add var_to_symbol_tbl var symbol in let assign_existing_symbol = Variable.Tbl.add var_to_symbol_tbl var in @@ -73,7 +68,7 @@ let assign_symbols_and_collect_constant_definitions record_definition (AA.Set_of_closures set); Variable.Map.iter (fun fun_var _ -> let closure_id = Closure_id.wrap fun_var in - let closure_symbol = closure_symbol ~backend closure_id in + let closure_symbol = Symbol_utils.Flambda.for_closure closure_id in Variable.Tbl.add var_to_symbol_tbl fun_var closure_symbol; let project_closure = Alias_analysis.Project_closure @@ -84,10 +79,10 @@ let assign_symbols_and_collect_constant_definitions funs | Move_within_set_of_closures ({ closure = _; start_from = _; move_to; } as move) -> - assign_existing_symbol (closure_symbol ~backend move_to); + assign_existing_symbol (Symbol_utils.Flambda.for_closure move_to); record_definition (AA.Move_within_set_of_closures move) | Project_closure ({ closure_id } as project_closure) -> - assign_existing_symbol (closure_symbol ~backend closure_id); + assign_existing_symbol (Symbol_utils.Flambda.for_closure closure_id); record_definition (AA.Project_closure project_closure) | Prim (Pfield index, [block], _) -> record_definition (AA.Field (block, index)) @@ -156,7 +151,7 @@ let assign_symbols_and_collect_constant_definitions if constant then begin Variable.Map.iter (fun fun_var _ -> let closure_id = Closure_id.wrap fun_var in - let closure_symbol = closure_symbol ~backend closure_id in + let closure_symbol = Symbol_utils.Flambda.for_closure closure_id in Variable.Tbl.add var_to_definition_tbl fun_var (AA.Symbol closure_symbol); Variable.Tbl.add var_to_symbol_tbl fun_var closure_symbol) @@ -748,10 +743,10 @@ let var_to_block_field var_to_definition_tbl; var_to_block_field_tbl -let program_symbols ~backend (program : Flambda.program) = +let program_symbols (program : Flambda.program) = let new_fake_symbol () = let var = Variable.create Internal_variable_names.fake_effect_symbol in - Symbol.of_variable var + Symbol_utils.Flambda.for_variable var in let initialize_symbol_tbl = Symbol.Tbl.create 42 in let effect_tbl = Symbol.Tbl.create 42 in @@ -762,7 +757,7 @@ let program_symbols ~backend (program : Flambda.program) = | Set_of_closures { function_decls = { funs } } -> Variable.Map.iter (fun fun_var _ -> let closure_id = Closure_id.wrap fun_var in - let closure_symbol = closure_symbol ~backend closure_id in + let closure_symbol = Symbol_utils.Flambda.for_closure closure_id in let project_closure = Flambda.Project_closure (def_symbol, closure_id) in @@ -865,7 +860,7 @@ let project_closure_map symbol_definition_map = let lift_constants (program : Flambda.program) ~backend = let the_dead_constant = let var = Variable.create Internal_variable_names.the_dead_constant in - Symbol.of_variable var + Symbol_utils.Flambda.for_variable var in let program_body : Flambda.program_body = Let_symbol (the_dead_constant, Allocated_const (Nativeint 0n), @@ -879,12 +874,11 @@ let lift_constants (program : Flambda.program) ~backend = ~compilation_unit:(Compilation_unit.get_current_exn ()) in let initialize_symbol_tbl, symbol_definition_tbl, effect_tbl = - program_symbols ~backend program + program_symbols program in let var_to_symbol_tbl, var_to_definition_tbl, let_symbol_to_definition_tbl, initialize_symbol_to_definition_tbl = - assign_symbols_and_collect_constant_definitions ~backend ~program - ~inconstants + assign_symbols_and_collect_constant_definitions ~program ~inconstants in let aliases = Alias_analysis.run var_to_definition_tbl diff --git a/middle_end/flambda/lift_let_to_initialize_symbol.ml b/middle_end/flambda/lift_let_to_initialize_symbol.ml index 3d8ed182581..77c4a07ffd9 100644 --- a/middle_end/flambda/lift_let_to_initialize_symbol.ml +++ b/middle_end/flambda/lift_let_to_initialize_symbol.ml @@ -177,11 +177,11 @@ let rebuild (used_variables:Variable.Set.t) (accumulated:accumulated) = List.map (fun decl -> match decl with | Block (var, _, _) | Expr (var, _) -> - Symbol.of_variable (Variable.rename var), decl + Symbol_utils.Flambda.for_variable (Variable.rename var), decl | Exprs _ -> let name = Internal_variable_names.lifted_let_rec_block in let var = Variable.create name in - Symbol.of_variable var, decl) + Symbol_utils.Flambda.for_variable var, decl) accumulated.extracted_lets in let extracted_definitions = diff --git a/middle_end/flambda/remove_unused_arguments.ml b/middle_end/flambda/remove_unused_arguments.ml index f0542e36664..9322560ef43 100644 --- a/middle_end/flambda/remove_unused_arguments.ml +++ b/middle_end/flambda/remove_unused_arguments.ml @@ -113,9 +113,9 @@ let make_stub unused var (fun_decl : Flambda.function_declaration) function_decl, renamed, additional_specialised_args let separate_unused_arguments ~only_specialised - ~backend ~(set_of_closures : Flambda.set_of_closures) = + ~(set_of_closures : Flambda.set_of_closures) = let function_decls = set_of_closures.function_decls in - let unused = Invariant_params.unused_arguments ~backend function_decls in + let unused = Invariant_params.unused_arguments function_decls in let non_stub_arguments = Variable.Map.fold (fun _ (decl : Flambda.function_declaration) acc -> if decl.stub then @@ -185,14 +185,13 @@ let separate_unused_arguments ~only_specialised args should always be beneficial since they should not be used in indirect calls. *) let should_split_only_specialised_args - (fun_decls : Flambda.function_declarations) - ~backend = + (fun_decls : Flambda.function_declarations) = if not !Clflags.remove_unused_arguments then begin true end else begin let no_recursive_functions = Variable.Set.is_empty - (Find_recursive_functions.in_function_declarations fun_decls ~backend) + (Find_recursive_functions.in_function_declarations fun_decls) in let number_of_non_stub_functions = Variable.Map.cardinal @@ -205,15 +204,13 @@ let should_split_only_specialised_args no_recursive_functions && (number_of_non_stub_functions <= 1) end -let separate_unused_arguments_in_set_of_closures set_of_closures ~backend = +let separate_unused_arguments_in_set_of_closures set_of_closures = let dump = Clflags.dumped_pass pass_name in let only_specialised = should_split_only_specialised_args set_of_closures.Flambda.function_decls - ~backend in - match separate_unused_arguments - ~only_specialised ~backend ~set_of_closures with + match separate_unused_arguments ~only_specialised ~set_of_closures with | None -> if dump then Format.eprintf "No change for Remove_unused_arguments:@ %a@.@." @@ -227,17 +224,15 @@ let separate_unused_arguments_in_set_of_closures set_of_closures ~backend = Flambda.print_set_of_closures result; Some result -let separate_unused_arguments_in_closures_expr tree ~backend = +let separate_unused_arguments_in_closures_expr tree = let aux_named (named : Flambda.named) : Flambda.named = match named with | Set_of_closures set_of_closures -> begin let only_specialised = should_split_only_specialised_args set_of_closures.function_decls - ~backend in - match separate_unused_arguments - ~only_specialised ~backend ~set_of_closures with + match separate_unused_arguments ~only_specialised ~set_of_closures with | None -> named | Some set_of_closures -> Set_of_closures set_of_closures end @@ -245,6 +240,6 @@ let separate_unused_arguments_in_closures_expr tree ~backend = in Flambda_iterators.map_named aux_named tree -let separate_unused_arguments_in_closures program ~backend = +let separate_unused_arguments_in_closures program = Flambda_iterators.map_exprs_at_toplevel_of_program program ~f:(fun expr -> - separate_unused_arguments_in_closures_expr expr ~backend) + separate_unused_arguments_in_closures_expr expr) diff --git a/middle_end/flambda/remove_unused_arguments.mli b/middle_end/flambda/remove_unused_arguments.mli index 759b32f2d2b..852fce48fa7 100644 --- a/middle_end/flambda/remove_unused_arguments.mli +++ b/middle_end/flambda/remove_unused_arguments.mli @@ -30,10 +30,8 @@ *) val separate_unused_arguments_in_closures : Flambda.program - -> backend:(module Backend_intf.S) -> Flambda.program val separate_unused_arguments_in_set_of_closures : Flambda.set_of_closures - -> backend:(module Backend_intf.S) -> Flambda.set_of_closures option diff --git a/middle_end/flambda/simple_value_approx.ml b/middle_end/flambda/simple_value_approx.ml index 017bfc37fa7..98baf058d57 100644 --- a/middle_end/flambda/simple_value_approx.ml +++ b/middle_end/flambda/simple_value_approx.ml @@ -222,7 +222,7 @@ let rec print_descr ppf = function and print ppf { descr; var; symbol; } = let print ppf = function - | None -> Symbol.print_opt ppf None + | None -> Misc.Stdlib.Option.print Symbol.print ppf None | Some (sym, None) -> Symbol.print ppf sym | Some (sym, Some field) -> Format.fprintf ppf "%a.(%i)" Symbol.print sym field diff --git a/middle_end/flambda/unbox_specialised_args.ml b/middle_end/flambda/unbox_specialised_args.ml index 20d69c1d653..428e7f9608b 100644 --- a/middle_end/flambda/unbox_specialised_args.ml +++ b/middle_end/flambda/unbox_specialised_args.ml @@ -45,7 +45,6 @@ module Transform = struct as well as the "_in_recursion" map *) let invariant_params_flow = Invariant_params.invariant_param_sources set_of_closures.function_decls - ~backend:(Inline_and_simplify_aux.Env.backend env) in Variable.Map.fold (fun fun_var extractions what_to_specialise -> Projection.Set.fold (fun (projection : Projection.t) diff --git a/middle_end/symbol.ml b/middle_end/symbol.ml deleted file mode 100644 index 22a2e0a70e7..00000000000 --- a/middle_end/symbol.ml +++ /dev/null @@ -1,105 +0,0 @@ -(**************************************************************************) -(* *) -(* OCaml *) -(* *) -(* Pierre Chambart, OCamlPro *) -(* Mark Shinwell and Leo White, Jane Street Europe *) -(* *) -(* Copyright 2013--2016 OCamlPro SAS *) -(* Copyright 2014--2016 Jane Street Group LLC *) -(* *) -(* All rights reserved. This file is distributed under the terms of *) -(* the GNU Lesser General Public License version 2.1, with the *) -(* special exception on linking described in the file LICENSE. *) -(* *) -(**************************************************************************) - -[@@@ocaml.warning "+a-4-9-30-40-41-42-66"] -open! Int_replace_polymorphic_compare - - -type t = - | Linkage of - { compilation_unit : Compilation_unit.t; - label : Linkage_name.t; - hash : int; } - | Variable of - { compilation_unit : Compilation_unit.t; - variable : Variable.t; } - -let label t = - match t with - | Linkage { label; _ } -> label - | Variable { variable; _ } -> - (* Use the variable's compilation unit for the label, since the - symbol's compilation unit might be a pack *) - let compilation_unit = Variable.get_compilation_unit variable in - let unit_linkage_name = - Linkage_name.to_string - (Compilation_unit.get_linkage_name compilation_unit) - in - let label = unit_linkage_name ^ "__" ^ Variable.unique_name variable in - Linkage_name.create label - -include Identifiable.Make (struct - - type nonrec t = t - - let compare t1 t2 = - if t1 == t2 then 0 - else begin - match t1, t2 with - | Linkage _, Variable _ -> 1 - | Variable _, Linkage _ -> -1 - | Linkage l1, Linkage l2 -> - let c = compare l1.hash l2.hash in - if c <> 0 then c else begin - (* Linkage names are unique across a whole project, so just comparing - those is sufficient. *) - Linkage_name.compare l1.label l2.label - end - | Variable v1, Variable v2 -> - Variable.compare v1.variable v2.variable - end - - let equal x y = - if x == y then true - else compare x y = 0 - - let output chan t = - Linkage_name.output chan (label t) - - let hash t = - match t with - | Linkage { hash; _ } -> hash - | Variable { variable } -> Variable.hash variable - - let print ppf t = - Linkage_name.print ppf (label t) - -end) - -let of_global_linkage compilation_unit label = - let hash = Linkage_name.hash label in - Linkage { compilation_unit; hash; label } - -let of_variable variable = - let compilation_unit = Variable.get_compilation_unit variable in - Variable { variable; compilation_unit } - -let import_for_pack ~pack:compilation_unit symbol = - match symbol with - | Linkage l -> Linkage { l with compilation_unit } - | Variable v -> Variable { v with compilation_unit } - -let compilation_unit t = - match t with - | Linkage { compilation_unit; _ } -> compilation_unit - | Variable { compilation_unit; _ } -> compilation_unit - -let print_opt ppf = function - | None -> Format.fprintf ppf "" - | Some t -> print ppf t - -let compare_lists l1 l2 = - Misc.Stdlib.List.compare compare l1 l2 diff --git a/middle_end/symbol.mli b/middle_end/symbol_utils.ml similarity index 53% rename from middle_end/symbol.mli rename to middle_end/symbol_utils.ml index d2771af2445..021fb772aa2 100644 --- a/middle_end/symbol.mli +++ b/middle_end/symbol_utils.ml @@ -6,7 +6,7 @@ (* Mark Shinwell and Leo White, Jane Street Europe *) (* *) (* Copyright 2013--2016 OCamlPro SAS *) -(* Copyright 2014--2016 Jane Street Group LLC *) +(* Copyright 2014--2021 Jane Street Group LLC *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) @@ -14,31 +14,27 @@ (* *) (**************************************************************************) -[@@@ocaml.warning "+a-4-9-30-40-41-42"] +[@@@ocaml.warning "+a-9-30-40-41-42"] -(** A symbol identifies a constant provided by either: - - another compilation unit; or - - a top-level module. +module CU = Compilation_unit - * [sym_unit] is the compilation unit containing the value. - * [sym_label] is the linkage name of the variable. +module Flambda = struct + let for_variable var = + Symbol.for_name (Variable.get_compilation_unit var) (Variable.unique_name var) - The label must be globally unique: two compilation units linked in the - same program must not share labels. *) + let for_closure closure_id = + Symbol.for_name (Closure_id.get_compilation_unit closure_id) + (Closure_id.unique_name closure_id ^ "_closure") -include Identifiable.S + let for_code_of_closure closure_id = + Symbol.for_name (Closure_id.get_compilation_unit closure_id) + (Closure_id.unique_name closure_id) -val of_variable : Variable.t -> t - -(* Create the symbol without prefixing with the compilation unit. - Used for global symbols like predefined exceptions *) -val of_global_linkage : Compilation_unit.t -> Linkage_name.t -> t - -val import_for_pack : pack:Compilation_unit.t -> t -> t - -val compilation_unit : t -> Compilation_unit.t -val label : t -> Linkage_name.t - -val print_opt : Format.formatter -> t option -> unit - -val compare_lists : t list -> t list -> int + (* CR-soon lmaurer: Be rid of this when we have prefixes set correctly to begin + with *) + let import_for_pack symbol ~pack = + let compilation_unit = + CU.with_for_pack_prefix (Symbol.compilation_unit symbol) pack + in + Symbol.with_compilation_unit symbol compilation_unit +end diff --git a/middle_end/compilation_unit.mli b/middle_end/symbol_utils.mli similarity index 66% rename from middle_end/compilation_unit.mli rename to middle_end/symbol_utils.mli index fc7d3bfded1..38c84cd7bc2 100644 --- a/middle_end/compilation_unit.mli +++ b/middle_end/symbol_utils.mli @@ -6,7 +6,7 @@ (* Mark Shinwell and Leo White, Jane Street Europe *) (* *) (* Copyright 2013--2016 OCamlPro SAS *) -(* Copyright 2014--2016 Jane Street Group LLC *) +(* Copyright 2014--2021 Jane Street Group LLC *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) @@ -14,21 +14,12 @@ (* *) (**************************************************************************) -[@@@ocaml.warning "+a-4-9-30-40-41-42"] +[@@@ocaml.warning "+a-30-40-41-42"] -include Identifiable.S +module Flambda : sig + val for_variable : Variable.t -> Symbol.t + val for_closure : Closure_id.t -> Symbol.t + val for_code_of_closure : Closure_id.t -> Symbol.t -(* The [Ident.t] must be persistent. This function raises an exception - if that is not the case. *) -val create : Ident.t -> Linkage_name.t -> t - -val get_persistent_ident : t -> Ident.t -val get_linkage_name : t -> Linkage_name.t - -val is_current : t -> bool -val set_current : t -> unit -val get_current : unit -> t option -val get_current_exn : unit -> t -val get_current_id_exn : unit -> Ident.t - -val string_for_printing : t -> string + val import_for_pack : Symbol.t -> pack:Compilation_unit.Prefix.t -> Symbol.t +end diff --git a/otherlibs/dynlink/Makefile b/otherlibs/dynlink/Makefile index e45692889df..74be81b207c 100644 --- a/otherlibs/dynlink/Makefile +++ b/otherlibs/dynlink/Makefile @@ -83,6 +83,10 @@ COMPILERLIBS_SOURCES=\ utils/local_store.ml \ utils/load_path.ml \ utils/int_replace_polymorphic_compare.ml \ + typing/ident.ml \ + utils/compilation_unit.ml \ + utils/linkage_name.ml \ + utils/symbol.ml \ parsing/location.ml \ parsing/longident.ml \ parsing/docstrings.ml \ @@ -91,7 +95,6 @@ COMPILERLIBS_SOURCES=\ parsing/ast_mapper.ml \ parsing/attr_helper.ml \ parsing/builtin_attributes.ml \ - typing/ident.ml \ typing/path.ml \ typing/primitive.ml \ typing/type_immediacy.ml \ @@ -106,6 +109,10 @@ COMPILERLIBS_SOURCES=\ lambda/debuginfo.ml \ lambda/lambda.ml \ lambda/runtimedef.ml \ + middle_end/internal_variable_names.ml \ + middle_end/variable.ml \ + middle_end/flambda/base_types/closure_element.ml \ + middle_end/flambda/base_types/closure_id.ml \ bytecomp/instruct.ml \ bytecomp/opcodes.ml \ bytecomp/bytesections.ml \ diff --git a/otherlibs/dynlink/dune b/otherlibs/dynlink/dune index 052b9985ad9..f0f6006c16f 100644 --- a/otherlibs/dynlink/dune +++ b/otherlibs/dynlink/dune @@ -71,7 +71,10 @@ outcometree cmo_format cmxs_format - debug_event) + debug_event + compilation_unit + symbol + linkage_name) (modules_without_implementation asttypes parsetree @@ -105,6 +108,9 @@ (copy_files ../../utils/warnings.ml) (copy_files ../../utils/load_path.ml) (copy_files ../../utils/int_replace_polymorphic_compare.ml) +(copy_files ../../utils/compilation_unit.ml) +(copy_files ../../utils/symbol.ml) +(copy_files ../../utils/linkage_name.ml) (copy_files ../../parsing/location.ml) (copy_files ../../parsing/longident.ml) (copy_files ../../parsing/docstrings.ml) @@ -151,6 +157,9 @@ (copy_files ../../utils/warnings.mli) (copy_files ../../utils/load_path.mli) (copy_files ../../utils/int_replace_polymorphic_compare.mli) +(copy_files ../../utils/compilation_unit.mli) +(copy_files ../../utils/symbol.mli) +(copy_files ../../utils/linkage_name.mli) (copy_files ../../parsing/location.mli) (copy_files ../../parsing/longident.mli) (copy_files ../../parsing/docstrings.mli) @@ -219,6 +228,7 @@ -g -a -ccopt %{read:natdynlinkops} -o dynlink.cma + ; NOTE: Be sure to keep these arguments in dependency order! .dynlink_compilerlibs.objs/byte/dynlink_compilerlibs__Binutils.cmo .dynlink_compilerlibs.objs/byte/dynlink_compilerlibs__Local_store.cmo .dynlink_compilerlibs.objs/byte/dynlink_compilerlibs__Build_path_prefix_map.cmo @@ -263,6 +273,9 @@ .dynlink_compilerlibs.objs/byte/dynlink_compilerlibs__Runtimedef.cmo .dynlink_compilerlibs.objs/byte/dynlink_compilerlibs__Symtable.cmo .dynlink_compilerlibs.objs/byte/dynlink_compilerlibs__Opcodes.cmo + .dynlink_compilerlibs.objs/byte/dynlink_compilerlibs__Compilation_unit.cmo + .dynlink_compilerlibs.objs/byte/dynlink_compilerlibs__Linkage_name.cmo + .dynlink_compilerlibs.objs/byte/dynlink_compilerlibs__Symbol.cmo .dynlink_internal.objs/byte/dynlink_types.cmo .dynlink_internal.objs/byte/dynlink_platform_intf.cmo .dynlink_internal.objs/byte/dynlink_common.cmo @@ -279,6 +292,7 @@ -g -a -ccopt %{read:natdynlinkops} -o dynlink.cmxa + ; NOTE: Be sure to keep these arguments in dependency order! .dynlink_compilerlibs.objs/native/dynlink_compilerlibs__Binutils.cmx .dynlink_compilerlibs.objs/native/dynlink_compilerlibs__Local_store.cmx .dynlink_compilerlibs.objs/native/dynlink_compilerlibs__Build_path_prefix_map.cmx @@ -323,6 +337,9 @@ .dynlink_compilerlibs.objs/native/dynlink_compilerlibs__Runtimedef.cmx .dynlink_compilerlibs.objs/native/dynlink_compilerlibs__Symtable.cmx .dynlink_compilerlibs.objs/native/dynlink_compilerlibs__Opcodes.cmx + .dynlink_compilerlibs.objs/native/dynlink_compilerlibs__Compilation_unit.cmx + .dynlink_compilerlibs.objs/native/dynlink_compilerlibs__Linkage_name.cmx + .dynlink_compilerlibs.objs/native/dynlink_compilerlibs__Symbol.cmx .dynlink_internal.objs/native/dynlink_types.cmx .dynlink_internal.objs/native/dynlink_platform_intf.cmx .dynlink_internal.objs/native/dynlink_common.cmx diff --git a/otherlibs/dynlink/dynlink.ml b/otherlibs/dynlink/dynlink.ml index be479c06710..78e27b7e4f5 100644 --- a/otherlibs/dynlink/dynlink.ml +++ b/otherlibs/dynlink/dynlink.ml @@ -27,9 +27,9 @@ module Bytecode = struct type filename = string module Unit_header = struct - type t = Cmo_format.compilation_unit + type t = Cmo_format.compilation_unit_descr - let name (t : t) = t.cu_name + let name (t : t) = Compilation_unit.Name.to_string t.cu_name let crc _t = None let interface_imports (t : t) = t.cu_imports @@ -98,7 +98,7 @@ module Bytecode = struct let run (ic, file_name, file_digest) ~filename:_ ~unit_header ~priv = let open Misc in let old_state = Symtable.current_state () in - let compunit : Cmo_format.compilation_unit = unit_header in + let compunit : Cmo_format.compilation_unit_descr = unit_header in seek_in ic compunit.cu_pos; let code_size = compunit.cu_codesize + 8 in let code = LongString.create code_size in @@ -124,7 +124,10 @@ module Bytecode = struct digest of file contents + unit name. Unit name is needed for .cma files, which produce several code fragments. *) - let digest = Digest.string (file_digest ^ compunit.cu_name) in + let digest = + Digest.string + (file_digest ^ Compilation_unit.Name.to_string compunit.cu_name) + in let events = if compunit.cu_debug = 0 then [| |] else begin @@ -152,7 +155,7 @@ module Bytecode = struct if buffer = Config.cmo_magic_number then begin let compunit_pos = input_binary_int ic in (* Go to descriptor *) seek_in ic compunit_pos; - let cu = (input_value ic : Cmo_format.compilation_unit) in + let cu = (input_value ic : Cmo_format.compilation_unit_descr) in handle, [cu] end else if buffer = Config.cma_magic_number then begin @@ -186,10 +189,10 @@ end module B = DC.Make (Bytecode) type global_map = { - name : string; + name : Compilation_unit.Name.t; crc_intf : Digest.t option; crc_impl : Digest.t option; - syms : string list + syms : Symbol.t list; } module Native = struct @@ -210,13 +213,19 @@ module Native = struct module Unit_header = struct type t = Cmxs_format.dynunit - let name (t : t) = t.dynu_name + let name (t : t) = t.dynu_name |> Compilation_unit.Name.to_string let crc (t : t) = Some t.dynu_crc let interface_imports (t : t) = t.dynu_imports_cmi let implementation_imports (t : t) = t.dynu_imports_cmx - let defined_symbols (t : t) = t.dynu_defines + let defined_symbols (t : t) = + List.map (fun comp_unit -> + Symbol.for_compilation_unit comp_unit + |> Symbol.linkage_name + |> Linkage_name.to_string) + t.dynu_defines + let unsafe_module _t = false end @@ -230,6 +239,12 @@ module Native = struct let fold_initial_units ~init ~f = let rank = ref 0 in List.fold_left (fun acc { name; crc_intf; crc_impl; syms; } -> + let name = Compilation_unit.Name.to_string name in + let syms = + List.map + (fun sym -> Symbol.linkage_name sym |> Linkage_name.to_string) + syms + in rank := !rank + List.length syms; let implementation = match crc_impl with diff --git a/runtime/dynlink_nat.c b/runtime/dynlink_nat.c index bbcfad571eb..2b1739517cc 100644 --- a/runtime/dynlink_nat.c +++ b/runtime/dynlink_nat.c @@ -43,7 +43,7 @@ static value Val_handle(void* handle) { } static void *getsym(void *handle, const char *module, const char *name){ - char *fullname = caml_stat_strconcat(3, "caml", module, name); + char *fullname = caml_stat_strconcat(2, module, name); void *sym; sym = caml_dlsym (handle, fullname); /* printf("%s => %lx\n", fullname, (uintnat) sym); */ diff --git a/testsuite/tests/lib-dynlink-initializers/test10_main.byte.reference b/testsuite/tests/lib-dynlink-initializers/test10_main.byte.reference index 197b8e55e31..d5efe697e95 100755 --- a/testsuite/tests/lib-dynlink-initializers/test10_main.byte.reference +++ b/testsuite/tests/lib-dynlink-initializers/test10_main.byte.reference @@ -3,8 +3,8 @@ Raised at Stdlib.failwith in file "stdlib.ml", line 32, characters 17-33 Called from Test10_plugin.g in file "test10_plugin.ml", line 3, characters 2-21 Called from Test10_plugin.f in file "test10_plugin.ml", line 6, characters 2-6 Called from Test10_plugin in file "test10_plugin.ml", line 10, characters 2-6 -Called from Dynlink.Bytecode.run in file "otherlibs/dynlink/dynlink.ml", line 137, characters 16-25 -Re-raised at Dynlink.Bytecode.run in file "otherlibs/dynlink/dynlink.ml", line 139, characters 6-137 +Called from Dynlink.Bytecode.run in file "otherlibs/dynlink/dynlink.ml", line 140, characters 16-25 +Re-raised at Dynlink.Bytecode.run in file "otherlibs/dynlink/dynlink.ml", line 142, characters 6-137 Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_common.ml", line 337, characters 13-54 Called from Stdlib__List.iter in file "list.ml", line 114, characters 12-15 Called from Dynlink_common.Make.load in file "otherlibs/dynlink/dynlink_common.ml", line 335, characters 8-250 diff --git a/testsuite/tests/lib-dynlink-initializers/test10_main.native.reference b/testsuite/tests/lib-dynlink-initializers/test10_main.native.reference index a5d34093876..9a06a1525c5 100755 --- a/testsuite/tests/lib-dynlink-initializers/test10_main.native.reference +++ b/testsuite/tests/lib-dynlink-initializers/test10_main.native.reference @@ -3,9 +3,9 @@ Raised at Stdlib.failwith in file "stdlib.ml", line 32, characters 17-33 Called from Test10_plugin.g in file "test10_plugin.ml" (inlined), line 2, characters 15-38 Called from Test10_plugin.f in file "test10_plugin.ml", line 6, characters 2-6 Called from Test10_plugin in file "test10_plugin.ml", line 10, characters 2-6 -Called from Dynlink.Native.ndl_run in file "otherlibs/dynlink/dynlink.ml", line 251, characters 8-25 -Called from Dynlink.Native.ndl_run in file "otherlibs/dynlink/dynlink.ml", line 251, characters 8-25 -Re-raised at Dynlink.Native.ndl_run in file "otherlibs/dynlink/dynlink.ml", line 263, characters 6-137 +Called from Dynlink.Native.ndl_run in file "otherlibs/dynlink/dynlink.ml", line 266, characters 8-25 +Called from Dynlink.Native.ndl_run in file "otherlibs/dynlink/dynlink.ml", line 266, characters 8-25 +Re-raised at Dynlink.Native.ndl_run in file "otherlibs/dynlink/dynlink.ml", line 278, characters 6-137 Called from Stdlib__List.iter in file "list.ml", line 114, characters 12-15 Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_common.ml", line 337, characters 13-54 Called from Stdlib__List.iter in file "list.ml", line 114, characters 12-15 diff --git a/testsuite/tests/tool-ocamlopt-save-ir/check_for_pack.compilers.reference b/testsuite/tests/tool-ocamlopt-save-ir/check_for_pack.compilers.reference index df07426a411..ef46ca4fe6a 100644 --- a/testsuite/tests/tool-ocamlopt-save-ir/check_for_pack.compilers.reference +++ b/testsuite/tests/tool-ocamlopt-save-ir/check_for_pack.compilers.reference @@ -1,2 +1,2 @@ File "check_for_pack.cmir-linear", line 1: -Error: This input file cannot be compiled with -for-pack foo: it was generated without -for-pack. +Error: This input file cannot be compiled with -for-pack Foo: it was generated without -for-pack. diff --git a/testsuite/tests/warnings/w55.flambda.reference b/testsuite/tests/warnings/w55.flambda.reference index 00bd36c0747..72ef246453b 100644 --- a/testsuite/tests/warnings/w55.flambda.reference +++ b/testsuite/tests/warnings/w55.flambda.reference @@ -2,11 +2,11 @@ File "w55.ml", line 33, characters 10-26: 33 | let h x = (j [@inlined]) x ^^^^^^^^^^^^^^^^ Warning 55 [inlining-impossible]: Cannot inline: [@inlined] attributes may not be used on partial applications -File "w55.ml", line 29, characters 10-27: -29 | let i x = (!r [@inlined]) x - ^^^^^^^^^^^^^^^^^ -Warning 55 [inlining-impossible]: Cannot inline: [@inlined] attribute was not used on this function application (the optimizer did not know what function was being applied) File "w55.ml", line 39, characters 12-30: 39 | let b x y = (a [@inlined]) x y ^^^^^^^^^^^^^^^^^^ Warning 55 [inlining-impossible]: Cannot inline: [@inlined] attribute was not used on this function application (the optimizer did not know what function was being applied) +File "w55.ml", line 29, characters 10-27: +29 | let i x = (!r [@inlined]) x + ^^^^^^^^^^^^^^^^^ +Warning 55 [inlining-impossible]: Cannot inline: [@inlined] attribute was not used on this function application (the optimizer did not know what function was being applied) diff --git a/testsuite/tools/codegen_main.ml b/testsuite/tools/codegen_main.ml index 314bbe50ca3..8cb23cdf0af 100644 --- a/testsuite/tools/codegen_main.ml +++ b/testsuite/tools/codegen_main.ml @@ -21,7 +21,11 @@ let compile_file filename = let out_name = Filename.chop_extension filename ^ ".s" in Emitaux.output_channel := open_out out_name end; (* otherwise, stdout *) - Compilenv.reset "test"; + let compilation_unit = + Compilation_unit.create Compilation_unit.Prefix.empty + ("test" |> Compilation_unit.Name.of_string) + in + Compilenv.reset compilation_unit; Clflags.cmm_invariants := true; Emit.begin_assembly(); let ic = open_in filename in diff --git a/tools/.depend b/tools/.depend index a39af1cd5a4..a8a34a8c45b 100644 --- a/tools/.depend +++ b/tools/.depend @@ -86,14 +86,13 @@ make_opcodes.cmo : make_opcodes.cmx : objinfo.cmo : \ ../bytecomp/symtable.cmi \ - ../middle_end/symbol.cmi \ + ../utils/symbol.cmi \ ../middle_end/printclambda.cmi \ ../utils/misc.cmi \ - ../middle_end/linkage_name.cmi \ ../lambda/lambda.cmi \ ../typing/ident.cmi \ ../middle_end/flambda/export_info.cmi \ - ../middle_end/compilation_unit.cmi \ + ../utils/compilation_unit.cmi \ ../file_formats/cmxs_format.cmi \ ../file_formats/cmx_format.cmi \ ../file_formats/cmt_format.cmi \ @@ -103,14 +102,13 @@ objinfo.cmo : \ ../utils/binutils.cmi objinfo.cmx : \ ../bytecomp/symtable.cmx \ - ../middle_end/symbol.cmx \ + ../utils/symbol.cmx \ ../middle_end/printclambda.cmx \ ../utils/misc.cmx \ - ../middle_end/linkage_name.cmx \ ../lambda/lambda.cmx \ ../typing/ident.cmx \ ../middle_end/flambda/export_info.cmx \ - ../middle_end/compilation_unit.cmx \ + ../utils/compilation_unit.cmx \ ../file_formats/cmxs_format.cmi \ ../file_formats/cmx_format.cmi \ ../file_formats/cmt_format.cmx \ diff --git a/tools/dumpobj.ml b/tools/dumpobj.ml index 01aff4396b9..a47cd54e338 100644 --- a/tools/dumpobj.ml +++ b/tools/dumpobj.ml @@ -500,7 +500,7 @@ let dump_obj ic = end; let cu_pos = input_binary_int ic in seek_in ic cu_pos; - let cu = (input_value ic : compilation_unit) in + let cu = (input_value ic : compilation_unit_descr) in reloc := cu.cu_reloc; if !print_reloc_info then List.iter print_reloc cu.cu_reloc; diff --git a/tools/objinfo.ml b/tools/objinfo.ml index 6efdafe9252..0f285b70491 100644 --- a/tools/objinfo.ml +++ b/tools/objinfo.ml @@ -60,11 +60,14 @@ let print_name_crc (name, crco) = let print_line name = printf "\t%s\n" name +let print_name_line cu = + printf "\t%a\n" Compilation_unit.Name.output (Compilation_unit.name cu) + let print_required_global id = printf "\t%s\n" (Ident.name id) let print_cmo_infos cu = - printf "Unit name: %s\n" cu.cu_name; + printf "Unit name: %a\n" Compilation_unit.Name.output cu.cu_name; print_string "Interfaces imported:\n"; List.iter print_name_crc cu.cu_imports; print_string "Required globals:\n"; @@ -116,11 +119,15 @@ let print_cmt_infos cmt = | None -> "" | Some crc -> string_of_crc crc) +let linkage_name comp_unit = + Symbol.for_compilation_unit comp_unit + |> Symbol.linkage_name_for_ocamlobjinfo + let print_general_infos name crc defines cmi cmx = printf "Name: %s\n" name; printf "CRC of implementation: %s\n" (string_of_crc crc); printf "Globals defined:\n"; - List.iter print_line defines; + List.iter print_line (List.map linkage_name defines); printf "Interfaces imported:\n"; List.iter print_name_crc cmi; printf "Implementations imported:\n"; @@ -136,8 +143,15 @@ open Cmx_format open Cmxs_format let print_cmx_infos (ui, crc) = + (* ocamlobjinfo has historically printed the name of the unit without + the pack prefix. *) + let comp_unit_without_pack_prefix = + Compilation_unit.create Compilation_unit.Prefix.empty + (Compilation_unit.name ui.ui_unit) + in print_general_infos - ui.ui_name crc ui.ui_defines ui.ui_imports_cmi ui.ui_imports_cmx; + (linkage_name comp_unit_without_pack_prefix) + crc ui.ui_defines ui.ui_imports_cmi ui.ui_imports_cmx; begin match ui.ui_export_info with | Clambda approx -> if not !no_approx then begin @@ -151,16 +165,8 @@ let print_cmx_infos (ui, crc) = else printf "Flambda unit\n"; if not !no_approx then begin - let cu = - Compilation_unit.create (Ident.create_persistent ui.ui_name) - (Linkage_name.create "__dummy__") - in - Compilation_unit.set_current cu; - let root_symbols = - List.map (fun s -> - Symbol.of_global_linkage cu (Linkage_name.create ("caml"^s))) - ui.ui_defines - in + Compilation_unit.set_current ui.ui_unit; + let root_symbols = List.map Symbol.for_compilation_unit ui.ui_defines in Format.printf "approximations@ %a@.@." Export_info.print_approx (export, root_symbols) end; @@ -192,7 +198,7 @@ let print_cmxs_infos header = List.iter (fun ui -> print_general_infos - ui.dynu_name + (ui.dynu_name |> Compilation_unit.Name.to_string) ui.dynu_crc ui.dynu_defines ui.dynu_imports_cmi @@ -280,7 +286,7 @@ let dump_obj_by_kind filename ic obj_kind = | Cmo -> let cu_pos = input_binary_int ic in seek_in ic cu_pos; - let cu = (input_value ic : compilation_unit) in + let cu = (input_value ic : compilation_unit_descr) in close_in ic; print_cmo_infos cu | Cma -> diff --git a/tools/primreq.ml b/tools/primreq.ml index 04832ad8c3b..d84824add07 100644 --- a/tools/primreq.ml +++ b/tools/primreq.ml @@ -43,7 +43,7 @@ let scan_obj filename = if buffer = cmo_magic_number then begin let cu_pos = input_binary_int ic in seek_in ic cu_pos; - let cu = (input_value ic : compilation_unit) in + let cu = (input_value ic : compilation_unit_descr) in close_in ic; scan_info cu end else diff --git a/toplevel/opttoploop.ml b/toplevel/opttoploop.ml index af6304f6de9..2ac70d1a36d 100644 --- a/toplevel/opttoploop.ml +++ b/toplevel/opttoploop.ml @@ -33,7 +33,7 @@ external ndl_run_toplevel: string -> string -> res = "caml_natdynlink_run_toplevel" let global_symbol id = - let sym = Compilenv.symbol_for_global id in + let sym = Compilenv.symbol_for_global id |> Linkage_name.to_string in match Dynlink.unsafe_get_global_value ~bytecode_or_asm_symbol:sym with | None -> fatal_error ("Opttoploop.global_symbol " ^ (Ident.unique_name id)) @@ -99,7 +99,7 @@ let toplevel_value id = let rec eval_address = function | Env.Aident id -> - if Ident.persistent id || Ident.global id + if Ident.is_global_or_predef id then global_symbol id else toplevel_value id | Env.Adot(a, pos) -> @@ -224,8 +224,7 @@ let phrase_name = ref "TOP" module Backend = struct (* See backend_intf.mli. *) - let symbol_for_global' = Compilenv.symbol_for_global' - let closure_symbol = Compilenv.closure_symbol + let pack_prefix_for_global_ident = Compilenv.pack_prefix_for_global_ident let really_import_approx = Import_approx.really_import_approx let import_symbol = Import_approx.import_symbol @@ -271,7 +270,11 @@ let load_lambda ppf ~module_ident ~required_globals lam size = if Filename.is_implicit dll then Filename.concat (Sys.getcwd ()) dll else dll in - let res = dll_run dll !phrase_name in + (* CR-someday lmaurer: The manual prefixing here feels wrong. Probably + [!phrase_name] should be a [Compilation_unit.t] (from which we can extract + a linkage name like civilized folk). That will be easier to do once we have + better types in, say, the [Translmod] API. *) + let res = dll_run dll ("caml" ^ !phrase_name) in (try Sys.remove dll with Sys_error _ -> ()); (* note: under windows, cannot remove a loaded dll (should remember the handles, close them in at_exit, and then remove @@ -317,7 +320,11 @@ let execute_phrase print_outcome ppf phr = let oldsig = !toplevel_sig in incr phrase_seqid; phrase_name := Printf.sprintf "TOP%i" !phrase_seqid; - Compilenv.reset ?packname:None !phrase_name; + let phrase_comp_unit = + Compilation_unit.create Compilation_unit.Prefix.empty + (Compilation_unit.Name.of_string !phrase_name) + in + Compilenv.reset phrase_comp_unit; Typecore.reset_delayed_checks (); let sstr, rewritten = match sstr with diff --git a/toplevel/topdirs.ml b/toplevel/topdirs.ml index 89d3eba4397..729f6ba15bf 100644 --- a/toplevel/topdirs.ml +++ b/toplevel/topdirs.ml @@ -179,7 +179,7 @@ and really_load_file recursive ppf name filename ic = if buffer = Config.cmo_magic_number then begin let compunit_pos = input_binary_int ic in (* Go to descriptor *) seek_in ic compunit_pos; - let cu : compilation_unit = input_value ic in + let cu : compilation_unit_descr = input_value ic in if recursive then List.iter (function diff --git a/toplevel/toploop.ml b/toplevel/toploop.ml index 2b6ca3c6b7f..f9e69b262b5 100644 --- a/toplevel/toploop.ml +++ b/toplevel/toploop.ml @@ -58,7 +58,7 @@ let setvalue name v = let rec eval_address = function | Env.Aident id -> - if Ident.persistent id || Ident.global id then + if Ident.is_global_or_predef id then Symtable.get_global_value id else begin let name = Translmod.toplevel_name id in diff --git a/typing/env.ml b/typing/env.ml index 4f8620186c2..c85487f6bfe 100644 --- a/typing/env.ml +++ b/typing/env.ml @@ -716,7 +716,7 @@ end = struct let is name = !current_unit = name let is_ident id = - Ident.persistent id && is (Ident.name id) + Ident.is_global id && is (Ident.name id) let is_path = function | Pident id -> is_ident id | Pdot _ | Papply _ -> false @@ -729,7 +729,7 @@ let find_same_module id tbl = match IdTbl.find_same id tbl with | x -> x | exception Not_found - when Ident.persistent id && not (Current_unit_name.is_ident id) -> + when Ident.is_global id && not (Current_unit_name.is_ident id) -> Mod_persistent let find_name_module ~mark name tbl = @@ -740,7 +740,7 @@ let find_name_module ~mark name tbl = path, Mod_persistent let add_persistent_structure id env = - if not (Ident.persistent id) then invalid_arg "Env.add_persistent_structure"; + if not (Ident.is_global id) then invalid_arg "Env.add_persistent_structure"; if Current_unit_name.is_ident id then env else begin let material = @@ -1159,12 +1159,12 @@ let required_globals = s_ref [] let reset_required_globals () = required_globals := [] let get_required_globals () = !required_globals let add_required_global id = - if Ident.global id && not !Clflags.transparent_modules + if Ident.is_global_or_predef id && not !Clflags.transparent_modules && not (List.exists (Ident.same id) !required_globals) then required_globals := id :: !required_globals let rec normalize_module_path lax env = function - | Pident id as path when lax && Ident.persistent id -> + | Pident id as path when lax && Ident.is_global id -> path (* fast path (avoids lookup) *) | Pdot (p, s) as path -> let p' = normalize_module_path lax env p in @@ -1184,12 +1184,12 @@ and expand_module_path lax env path = let path' = normalize_module_path lax env path1 in if lax || !Clflags.transparent_modules then path' else let id = Path.head path in - if Ident.global id && not (Ident.same id (Path.head path')) + if Ident.is_global_or_predef id && not (Ident.same id (Path.head path')) then add_required_global id; path' | _ -> path with Not_found when lax - || (match path with Pident id -> not (Ident.persistent id) | _ -> true) -> + || (match path with Pident id -> not (Ident.is_global id) | _ -> true) -> path let normalize_module_path oloc env path = @@ -1331,7 +1331,7 @@ let rec scrape_alias_for_visit env mty = | MtyL_alias path -> begin match path with | Pident id - when Ident.persistent id + when Ident.is_global id && not (Persistent_env.looked_up !persistent_env (Ident.name id)) -> false | path -> (* PR#6600: find_module may raise Not_found *) diff --git a/typing/ident.ml b/typing/ident.ml index feb590d0240..c3ff38a1354 100644 --- a/typing/ident.ml +++ b/typing/ident.ml @@ -79,10 +79,6 @@ let unique_toplevel_name = function | Global name | Predef { name; _ } -> name -let persistent = function - | Global _ -> true - | _ -> false - let equal i1 i2 = match i1, i2 with | Local { name = name1; _ }, Local { name = name2; _ } @@ -123,7 +119,11 @@ let reinit () = then reinit_level := !currentstamp else currentstamp := !reinit_level -let global = function +let is_global = function + | Global _ -> true + | _ -> false + +let is_global_or_predef = function | Local _ | Scoped _ -> false | Global _ diff --git a/typing/ident.mli b/typing/ident.mli index ff48efb3ad6..0bbc3156a05 100644 --- a/typing/ident.mli +++ b/typing/ident.mli @@ -42,7 +42,6 @@ val rename: t -> t val name: t -> string val unique_name: t -> string val unique_toplevel_name: t -> string -val persistent: t -> bool val same: t -> t -> bool (** Compare identifiers by binding location. Two identifiers are the same either if they are both @@ -52,7 +51,8 @@ val same: t -> t -> bool val compare: t -> t -> int -val global: t -> bool +val is_global: t -> bool +val is_global_or_predef: t -> bool val is_predef: t -> bool val scope: t -> int diff --git a/typing/types.ml b/typing/types.ml index 0cd2d4c54d7..2d1afd786a6 100644 --- a/typing/types.ml +++ b/typing/types.ml @@ -132,7 +132,7 @@ module Uid = struct Item { comp_unit = current_unit; id = !id } let of_compilation_unit_id id = - if not (Ident.persistent id) then + if not (Ident.is_global id) then Misc.fatal_errorf "Types.Uid.of_compilation_unit_id %S" (Ident.name id); Compilation_unit (Ident.name id) diff --git a/utils/compilation_unit.ml b/utils/compilation_unit.ml new file mode 100644 index 00000000000..49e29068da0 --- /dev/null +++ b/utils/compilation_unit.ml @@ -0,0 +1,278 @@ +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Pierre Chambart and Pierrick Couderc, OCamlPro *) +(* Mark Shinwell and Leo White, Jane Street Europe *) +(* *) +(* Copyright 2013--2020 OCamlPro SAS *) +(* Copyright 2014--2021 Jane Street Group LLC *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +[@@@ocaml.warning "+a-9-40-41-42"] + +open! Int_replace_polymorphic_compare + +module List = Misc.Stdlib.List +module String = Misc.Stdlib.String + +type error = + | Invalid_character of char + | Bad_compilation_unit_name of string + +exception Error of error + +(* CR-someday lmaurer: Move this to [Identifiable] and change /all/ definitions + of [output] that delegate to [print] to use it. Yes, they're all broken. *) +let output_of_print print = + let output out_channel t = + let ppf = Format.formatter_of_out_channel out_channel in + print ppf t; + (* Must flush the formatter immediately because it has a buffer separate + from the output channel's buffer *) + Format.pp_print_flush ppf () + in + output + +module Name : sig + type t + include Identifiable.S with type t := t + val dummy : t + val of_string : string -> t + val to_string : t -> string + val persistent_ident : t -> Ident.t + val check_as_path_component : t -> unit +end = struct + (* Be VERY careful changing this. Anything not equivalent to [string] will + require bumping magic numbers due to changes in file formats, in addition + to breaking the (somewhat horrifying) invariant on + [Cmm_helpers.globals_map]. Furthermore there are uses of polymorphic + compare hidden in [List.mem], [List.assoc] etc. *) + type t = string + + include Identifiable.Make (struct + type nonrec t = t + + let compare = String.compare + let equal = String.equal + let hash = Hashtbl.hash + let print = String.print + let output = output_of_print print + end) + + let isupper chr = + Char.equal (Char.uppercase_ascii chr) chr + + let of_string str = + if String.equal str "" + then raise (Error (Bad_compilation_unit_name str)) + else str + + (* This is so called (and separate from [of_string]) because we only want to + check a name if it has a prefix. In particular, this allows single-module + executables to have names like ".cinaps" that aren't valid module names. *) + let check_as_path_component t = + if String.length t < 1 + || not (isupper (String.get t 0)) + || String.contains t '.' + then raise (Error (Bad_compilation_unit_name t)) + + let dummy = "*dummy*" + + let to_string t = t + + let persistent_ident t = Ident.create_persistent t +end + +module Prefix : sig + type t + include Identifiable.S with type t := t + val parse_for_pack : string option -> t + val from_clflags : unit -> t + val to_list : t -> Name.t list + val to_string : t -> string + val empty : t + val is_empty : t -> bool +end = struct + (* As with [Name.t], changing this will change several file formats, requiring + bumps of magic numbers. *) + type t = Name.t list + + include Identifiable.Make (struct + type nonrec t = t + + let equal = List.equal Name.equal + + let compare = List.compare Name.compare + + let hash = Hashtbl.hash + + let print ppf p = + Format.pp_print_list + ~pp_sep:(fun ppf () -> Format.pp_print_string ppf ".") + Name.print ppf p + + let output = output_of_print print + end) + + let is_valid_character first_char c = + let code = Char.code c in + if first_char then + code >= 65 && code <= 90 (* [A-Z] *) + else + Char.equal c '_' + || code >= 48 && 57 <= 90 (* [0-9] *) + || code >= 65 && code <= 90 (* [A-Z] *) + || code >= 97 && code <= 122 (* [a-z] *) + + let parse pack = + let prefix = String.split_on_char '.' pack in + ListLabels.iter prefix ~f:(fun module_name -> + String.iteri (fun i c -> + if not (is_valid_character (i=0) c) then + raise (Error (Invalid_character c))) + module_name); + ListLabels.map prefix ~f:Name.of_string + + let parse_for_pack = function + | None -> [] + | Some pack -> parse pack + + let from_clflags () = parse_for_pack !Clflags.for_package + + let to_string p = + Format.asprintf "%a" print p + + let empty = [] + + let is_empty t = + match t with + | [] -> true + | _::_ -> false + + let to_list t = t +end + +(* As with [Name.t], changing this requires bumping magic numbers. *) +type t = { + name : Name.t; + for_pack_prefix : Prefix.t; + hash : int; +} + +let create for_pack_prefix name = + if not (Prefix.is_empty for_pack_prefix) then begin + Name.check_as_path_component name; + ListLabels.iter ~f:Name.check_as_path_component + (for_pack_prefix |> Prefix.to_list) + end; + { name; + for_pack_prefix; + hash = Hashtbl.hash (name, for_pack_prefix) + } + +let of_string str = + let for_pack_prefix, name = + match String.rindex_opt str '.' with + | None -> Prefix.empty, Name.of_string str + | Some 0 -> + (* See [Name.check_as_path_component]; this allows ".cinaps" as a + compilation unit *) + Prefix.empty, Name.of_string str + | Some pos -> + Prefix.parse_for_pack (Some (String.sub str 0 (pos+1))), + Name.of_string (String.sub str (pos+1) (String.length str - pos - 1)) + in + create for_pack_prefix name + +let dummy = create Prefix.empty (Name.of_string "*none*") + +let predef_exn = create Prefix.empty (Name.of_string "*predef*") + +let name t = t.name + +let for_pack_prefix t = t.for_pack_prefix + +let with_for_pack_prefix t for_pack_prefix = { t with for_pack_prefix; } + +let is_packed t = not (Prefix.is_empty t.for_pack_prefix) + +include Identifiable.Make (struct + type nonrec t = t + + let compare + ({ name = name1; for_pack_prefix = for_pack_prefix1; + hash = hash1; _} as t1) + ({ name = name2; for_pack_prefix = for_pack_prefix2; + hash = hash2; _} as t2) = + if t1 == t2 then 0 + else + let c = Stdlib.compare hash1 hash2 in + if c <> 0 then c + else + let c = Name.compare name1 name2 in + if c <> 0 then c + else Prefix.compare for_pack_prefix1 for_pack_prefix2 + + let equal x y = + if x == y then true + else compare x y = 0 + + let print fmt t = + if Prefix.is_empty t.for_pack_prefix then + Format.fprintf fmt "%a" Name.print t.name + else + Format.fprintf fmt "%a.%a" + Prefix.print t.for_pack_prefix + Name.print t.name + + let output = output_of_print print + + let hash t = t.hash +end) + +let full_path t = + (Prefix.to_list t.for_pack_prefix) @ [ t.name ] + +let is_parent t ~child = + List.equal Name.equal (full_path t) (Prefix.to_list child.for_pack_prefix) + +let print_name ppf t = + Format.fprintf ppf "%a" Name.print t.name + +let full_path_as_string t = + Format.asprintf "%a" print t + +let print_debug ppf { for_pack_prefix; hash = _; name } = + if Prefix.is_empty for_pack_prefix then + Format.fprintf ppf "@[(\ + @[(id@ %a)@])@]" + Name.print name + else + Format.fprintf ppf "@[(\ + @[(for_pack_prefix@ %a)@]@;\ + @[(name@ %a)@]" + Prefix.print for_pack_prefix + Name.print name + +let current = ref None + +let set_current t = + current := Some t + +let get_current () = !current + +let get_current_exn () = + match !current with + | Some t -> t + | None -> Misc.fatal_error "No compilation unit set" + +let is_current t = + match !current with + | None -> false + | Some t' -> equal t t' diff --git a/utils/compilation_unit.mli b/utils/compilation_unit.mli new file mode 100644 index 00000000000..72215ab9a14 --- /dev/null +++ b/utils/compilation_unit.mli @@ -0,0 +1,137 @@ +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Pierre Chambart and Pierrick Couderc, OCamlPro *) +(* Mark Shinwell and Leo White, Jane Street Europe *) +(* *) +(* Copyright 2013--2020 OCamlPro SAS *) +(* Copyright 2014--2021 Jane Street Group LLC *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(* Handling of the names of compilation units, including associated "-for-pack" + prefixes. + + By "compilation unit" we mean the code and data associated with the + compilation of a single .ml source file: that is to say, file-level + entities having OCaml semantics. The notion neither includes the special + "startup" files nor external libraries. +*) + +[@@@ocaml.warning "+a-9-40-41-42"] + +module Name : sig + (** The name of a compilation unit without any "-for-pack" prefix. *) + type t + + (** Printing, comparison, sets, maps, etc. *) + include Identifiable.S with type t := t + + (** [dummy] is a placeholder for units that does not have a valid name, as + in the, or during initialisation of the compiler. It is not a valid + identifier and thus cannot be generated through [of_string]. *) + val dummy : t + + (** [of_string s] checks the given module name is a valid compilation unit + name and generates its representation. *) + val of_string : string -> t + + val to_string : t -> string + + val persistent_ident : t -> Ident.t +end + +module Prefix : sig + (** A pack name prefix, as specified to "-for-pack". Such a prefix may + be empty. *) + type t + + (** Printing, comparison, sets, maps, etc. *) + include Identifiable.S with type t := t + + val empty : t + + (** [parse_for_pack p] returns the list of nested packed modules from a + "-for-pack" argument. *) + val parse_for_pack : string option -> t + + val from_clflags : unit -> t + + (** Return the list of names comprising the prefix, outermost first. *) + val to_list : t -> Name.t list + + val to_string : t -> string + + val is_empty : t -> bool +end + +(** The name of a compilation unit qualified with any "-for-pack" prefix that + was specified when the unit was compiled. For example if compiling foo.ml + with "-for-pack Baz.Bar", the corresponding value of type [t] would + represent "Baz.Bar.Foo", with its [name] representing "Foo" and its + [prefix] representing "Baz.Bar". *) +type t + +(** Printing, comparison, sets, maps, etc. *) +include Identifiable.S with type t := t + +(** Print only the name of the given compilation unit. *) +val print_name : Format.formatter -> t -> unit + +val print_debug : Format.formatter -> t -> unit + +(** Create a compilation unit with the given [name] (which is not encoded or + mangled in any way). *) +val create : Prefix.t -> Name.t -> t + +(** Create a compilation unit from the given [name]. The "-for-pack" of + prefix is extracted if there is any. *) +val of_string : string -> t + +(** Find whether one compilation unit has another as a child. That is, whether + the other unit has this one as its path prefix. *) +val is_parent : t -> child:t -> bool + +(** A distinguished compilation unit for initialisation of mutable state. *) +val dummy : t + +(** A distinguished compilation unit for predefined exceptions. *) +val predef_exn : t + +(** The name of the compilation unit, excluding any [for_pack_prefix]. *) +val name : t -> Name.t + +(** The "-for-pack" prefix associated with the given compilation unit. *) +val for_pack_prefix : t -> Prefix.t + +(** Replace the "-for-pack" prefix for the given compilation unit. *) +val with_for_pack_prefix : t -> Prefix.t -> t + +(** Returns [true] iff the given compilation unit has a non-empty + [for_pack_prefix]. *) +val is_packed : t -> bool + +(** Returns the full path of the compilation unit. The basename of the unit + will be the last component of the returned list. *) +val full_path : t -> Name.t list + +(** Returns the full path of the compilation unit, as a string, following + usual conventions. *) +val full_path_as_string : t -> string + +type error = private + | Invalid_character of char + | Bad_compilation_unit_name of string + +(** The exception raised by conversion functions in this module. *) +exception Error of error + +val set_current : t -> unit +val get_current : unit -> t option +val get_current_exn : unit -> t +val is_current : t -> bool diff --git a/middle_end/linkage_name.ml b/utils/linkage_name.ml similarity index 98% rename from middle_end/linkage_name.ml rename to utils/linkage_name.ml index 46febfba8fa..e4727c618ad 100644 --- a/middle_end/linkage_name.ml +++ b/utils/linkage_name.ml @@ -26,5 +26,5 @@ include Identifiable.Make (struct let output chan t = output_string chan t end) -let create t = t +let of_string t = t let to_string t = t diff --git a/middle_end/linkage_name.mli b/utils/linkage_name.mli similarity index 97% rename from middle_end/linkage_name.mli rename to utils/linkage_name.mli index 58731917cde..9f214ab76da 100644 --- a/middle_end/linkage_name.mli +++ b/utils/linkage_name.mli @@ -18,5 +18,5 @@ include Identifiable.S -val create : string -> t +val of_string : string -> t val to_string : t -> string diff --git a/utils/misc.mli b/utils/misc.mli index 0d4cba11273..0abb5bba39c 100644 --- a/utils/misc.mli +++ b/utils/misc.mli @@ -472,6 +472,9 @@ val print_if : type filepath = string + +(* CR-someday lmaurer: Retire [modname] in favor of [Compilation_unit.Name.t] + and alter [crcs] accordingly (move it into [Compilation_unit] somewhere?). *) type modname = string type crcs = (modname * Digest.t option) list diff --git a/utils/symbol.ml b/utils/symbol.ml new file mode 100644 index 00000000000..b0f993a5d28 --- /dev/null +++ b/utils/symbol.ml @@ -0,0 +1,146 @@ +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Pierre Chambart, OCamlPro *) +(* Mark Shinwell and Leo White, Jane Street Europe *) +(* *) +(* Copyright 2013--2016 OCamlPro SAS *) +(* Copyright 2014--2021 Jane Street Group LLC *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +[@@@ocaml.warning "+a-9-30-40-41-42"] + +module CU = Compilation_unit + +type t = { + compilation_unit : Compilation_unit.t; + linkage_name : Linkage_name.t; + hash : int; +} + +include Identifiable.Make (struct + type nonrec t = t + + let compare t1 t2 = + if t1 == t2 then 0 + else + let c = compare t1.hash t2.hash in + if c <> 0 then c + else + (* Linkage names are unique across a whole project, so just comparing + those is sufficient. *) + Linkage_name.compare t1.linkage_name t2.linkage_name + + let equal t1 t2 = compare t1 t2 = 0 + let output chan t = Linkage_name.output chan t.linkage_name + let hash { hash; } = hash + + (* CR mshinwell: maybe print all fields *) + let print ppf t = Linkage_name.print ppf t.linkage_name +end) + +let caml_symbol_prefix = "caml" +let separator = "__" + +let linkage_name t = t.linkage_name + +let linkage_name_for_ocamlobjinfo t = + (* For legacy compatibility, even though displaying "Foo.Bar" is nicer + than "Foo__Bar" *) + let linkage_name = linkage_name t |> Linkage_name.to_string in + assert (Misc.Stdlib.String.begins_with linkage_name + ~prefix:caml_symbol_prefix); + let prefix_len = String.length caml_symbol_prefix in + String.sub linkage_name prefix_len (String.length linkage_name - prefix_len) + +let compilation_unit t = t.compilation_unit + +let with_compilation_unit t compilation_unit = { t with compilation_unit } + +(* CR-someday lmaurer: Would be nicer to have some of this logic in + [Linkage_name]; among other things, we could then define + [Linkage_name.for_current_unit] *) + +let linkage_name_for_compilation_unit comp_unit = + let name = CU.Name.to_string (CU.name comp_unit) in + let for_pack_prefix = CU.for_pack_prefix comp_unit in + let suffix = + if CU.Prefix.is_empty for_pack_prefix then name + else + let pack_names = + CU.Prefix.to_list for_pack_prefix |> List.map CU.Name.to_string + in + String.concat separator (pack_names @ [name]) + in + caml_symbol_prefix ^ suffix + |> Linkage_name.of_string + +let for_global_or_predef_ident pack_prefix id = + assert (Ident.is_global_or_predef id); + let linkage_name, compilation_unit = + if Ident.is_predef id then + "caml_exn_" ^ Ident.name id |> Linkage_name.of_string, CU.predef_exn + else + let compilation_unit = + Compilation_unit.create pack_prefix + (Ident.name id |> Compilation_unit.Name.of_string) + in + linkage_name_for_compilation_unit compilation_unit, compilation_unit + in + { compilation_unit; + linkage_name; + hash = Hashtbl.hash linkage_name; + } + +let for_predef_ident id = + for_global_or_predef_ident Compilation_unit.Prefix.empty id + +let unsafe_create compilation_unit linkage_name = + { compilation_unit; + linkage_name; + hash = Hashtbl.hash linkage_name; } + +let for_name compilation_unit name = + let prefix = + linkage_name_for_compilation_unit compilation_unit |> Linkage_name.to_string + in + let linkage_name = + prefix ^ separator ^ name |> Linkage_name.of_string + in + { compilation_unit; + linkage_name; + hash = Hashtbl.hash linkage_name; } + +let for_local_ident id = + assert (not (Ident.is_global_or_predef id)); + let compilation_unit = CU.get_current_exn () in + for_name compilation_unit (Ident.unique_name id) + +let for_compilation_unit compilation_unit = + let linkage_name = linkage_name_for_compilation_unit compilation_unit in + { compilation_unit; + linkage_name; + hash = Hashtbl.hash linkage_name; + } + +let for_current_unit () = + for_compilation_unit (CU.get_current_exn ()) + +let import_for_pack t ~pack = + let compilation_unit = CU.with_for_pack_prefix t.compilation_unit pack in + { t with compilation_unit; } + +let const_label = ref 0 + +let for_new_const_in_current_unit () = + incr const_label; + for_name (Compilation_unit.get_current_exn ()) (Int.to_string !const_label) + +let is_predef_exn t = + CU.equal t.compilation_unit CU.predef_exn diff --git a/utils/symbol.mli b/utils/symbol.mli new file mode 100644 index 00000000000..a5d4a7e97be --- /dev/null +++ b/utils/symbol.mli @@ -0,0 +1,54 @@ +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Pierre Chambart, OCamlPro *) +(* Mark Shinwell and Leo White, Jane Street Europe *) +(* *) +(* Copyright 2013--2016 OCamlPro SAS *) +(* Copyright 2014--2021 Jane Street Group LLC *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +[@@@ocaml.warning "+a-30-40-41-42"] + +(** Symbols that identify statically-allocated code or data. *) + +type t + +val for_predef_ident : Ident.t -> t + +(* CR mshinwell: Insist on -for-pack for .mli files; then this function + will not need to take a pack prefix. *) +val for_global_or_predef_ident : Compilation_unit.Prefix.t -> Ident.t -> t + +(** It is assumed that the provided [Ident.t] is in the current unit. *) +val for_local_ident : Ident.t -> t + +(** To be avoided if possible. Linkage names are intended to be generated + by this module. *) +val unsafe_create : Compilation_unit.t -> Linkage_name.t -> t + +val for_name : Compilation_unit.t -> string -> t +val for_compilation_unit : Compilation_unit.t -> t +val for_current_unit : unit -> t +val for_new_const_in_current_unit : unit -> t + +val import_for_pack : t -> pack:Compilation_unit.Prefix.t -> t + +val compilation_unit : t -> Compilation_unit.t + +val with_compilation_unit : t -> Compilation_unit.t -> t + +val linkage_name : t -> Linkage_name.t + +(** Linkage names displayed in ocamlobjinfo are formatted differently. *) +val linkage_name_for_ocamlobjinfo : t -> string + +include Identifiable.S with type t := t + +val is_predef_exn : t -> bool