From 3fe19661ae391585852641ee873bafc0555c5ab7 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Thu, 30 Mar 2023 11:02:40 +0200 Subject: [PATCH 01/31] Towards prototyping untagged variants. Just disable the type error for now. --- jscomp/ml/typedecl.ml | 8 +++++++- jscomp/test/UntaggedVariants.js | 25 +++++++++++++++++++++++++ jscomp/test/UntaggedVariants.res | 11 +++++++++++ jscomp/test/build.ninja | 3 ++- 4 files changed, 45 insertions(+), 2 deletions(-) create mode 100644 jscomp/test/UntaggedVariants.js create mode 100644 jscomp/test/UntaggedVariants.res diff --git a/jscomp/ml/typedecl.ml b/jscomp/ml/typedecl.ml index c1a1e825c6..8dfe1bca78 100644 --- a/jscomp/ml/typedecl.ml +++ b/jscomp/ml/typedecl.ml @@ -303,7 +303,13 @@ let transl_declaration env sdecl id = sdecl.ptype_cstrs in let raw_status = get_unboxed_from_attributes sdecl in - if raw_status.unboxed && not raw_status.default then begin + + let checkUntaggedVariant = match sdecl.ptype_kind with + | Ptype_variant _ -> true + | _ -> false + in + + if raw_status.unboxed && not raw_status.default && not checkUntaggedVariant then begin match sdecl.ptype_kind with | Ptype_abstract -> raise(Error(sdecl.ptype_loc, Bad_unboxed_attribute diff --git a/jscomp/test/UntaggedVariants.js b/jscomp/test/UntaggedVariants.js new file mode 100644 index 0000000000..4e2a5abf10 --- /dev/null +++ b/jscomp/test/UntaggedVariants.js @@ -0,0 +1,25 @@ +'use strict'; + + +function classify(x) { + if (x.TAG === "I") { + return "An integer"; + } else { + return "A string"; + } +} + +var i = { + TAG: "I", + _0: 42 +}; + +var s = { + TAG: "S", + _0: "abc" +}; + +exports.i = i; +exports.s = s; +exports.classify = classify; +/* No side effect */ diff --git a/jscomp/test/UntaggedVariants.res b/jscomp/test/UntaggedVariants.res new file mode 100644 index 0000000000..6b1c205b7c --- /dev/null +++ b/jscomp/test/UntaggedVariants.res @@ -0,0 +1,11 @@ +@unboxed +type t = I(int) | S(string) + +let i = I(42) +let s = S("abc") + +let classify = x => + switch x { + | I(_) => "An integer" + | S(_) => "A string" + } diff --git a/jscomp/test/build.ninja b/jscomp/test/build.ninja index 81575a238e..5e2bceedd0 100644 --- a/jscomp/test/build.ninja +++ b/jscomp/test/build.ninja @@ -24,6 +24,7 @@ o test/SafePromises.cmi test/SafePromises.cmj : cc test/SafePromises.res | $bsc o test/UncurriedAlways.cmi test/UncurriedAlways.cmj : cc test/UncurriedAlways.res | $bsc $stdlib runtime o test/UncurriedExternals.cmi test/UncurriedExternals.cmj : cc test/UncurriedExternals.res | $bsc $stdlib runtime o test/UncurriedPervasives.cmi test/UncurriedPervasives.cmj : cc test/UncurriedPervasives.res | $bsc $stdlib runtime +o test/UntaggedVariants.cmi test/UntaggedVariants.cmj : cc test/UntaggedVariants.res | $bsc $stdlib runtime o test/a.cmi test/a.cmj : cc test/a.ml | test/test_order.cmj $bsc $stdlib runtime o test/a_filename_test.cmi test/a_filename_test.cmj : cc test/a_filename_test.ml | test/ext_filename_test.cmj test/mt.cmj $bsc $stdlib runtime o test/a_list_test.cmi test/a_list_test.cmj : cc test/a_list_test.ml | test/ext_list_test.cmj test/mt.cmj $bsc $stdlib runtime @@ -722,4 +723,4 @@ o test/variant.cmi test/variant.cmj : cc test/variant.ml | $bsc $stdlib runtime o test/variantsMatching.cmi test/variantsMatching.cmj : cc test/variantsMatching.res | $bsc $stdlib runtime o test/watch_test.cmi test/watch_test.cmj : cc test/watch_test.ml | $bsc $stdlib runtime o test/webpack_config.cmi test/webpack_config.cmj : cc test/webpack_config.ml | $bsc $stdlib runtime -o test : phony test/406_primitive_test.cmi test/406_primitive_test.cmj test/EmptyRecord.cmi test/EmptyRecord.cmj test/SafePromises.cmi test/SafePromises.cmj test/UncurriedAlways.cmi test/UncurriedAlways.cmj test/UncurriedExternals.cmi test/UncurriedExternals.cmj test/UncurriedPervasives.cmi test/UncurriedPervasives.cmj test/a.cmi test/a.cmj test/a_filename_test.cmi test/a_filename_test.cmj test/a_list_test.cmi test/a_list_test.cmj test/a_recursive_type.cmi test/a_recursive_type.cmj test/a_scope_bug.cmi test/a_scope_bug.cmj test/a_string_test.cmi test/a_string_test.cmj test/abstract_type.cmi test/abstract_type.cmj test/adt_optimize_test.cmi test/adt_optimize_test.cmj test/alias_default_value_test.cmi test/alias_default_value_test.cmj test/alias_test.cmi test/alias_test.cmj test/and_or_tailcall_test.cmi test/and_or_tailcall_test.cmj test/app_root_finder.cmi test/app_root_finder.cmj test/argv_test.cmi test/argv_test.cmj test/ari_regress_test.cmi test/ari_regress_test.cmj test/arith_lexer.cmi test/arith_lexer.cmj test/arith_parser.cmi test/arith_parser.cmj test/arith_syntax.cmi test/arith_syntax.cmj test/arity.cmi test/arity.cmj test/arity_deopt.cmi test/arity_deopt.cmj test/arity_infer.cmi test/arity_infer.cmj test/array_data_util.cmi test/array_data_util.cmj test/array_safe_get.cmi test/array_safe_get.cmj test/array_subtle_test.cmi test/array_subtle_test.cmj test/array_test.cmi test/array_test.cmj test/ast_abstract_test.cmi test/ast_abstract_test.cmj test/ast_mapper_unused_warning_test.cmi test/ast_mapper_unused_warning_test.cmj test/async_await.cmi test/async_await.cmj test/async_ideas.cmi test/async_ideas.cmj test/async_inline.cmi test/async_inline.cmj test/attr_test.cmi test/attr_test.cmj test/b.cmi test/b.cmj test/bal_set_mini.cmi test/bal_set_mini.cmj test/bang_primitive.cmi test/bang_primitive.cmj test/basic_module_test.cmi test/basic_module_test.cmj test/bb.cmi test/bb.cmj test/bdd.cmi test/bdd.cmj test/belt_internal_test.cmi test/belt_internal_test.cmj test/belt_result_alias_test.cmi test/belt_result_alias_test.cmj test/bench.cmi test/bench.cmj test/big_enum.cmi test/big_enum.cmj test/big_polyvar_test.cmi test/big_polyvar_test.cmj test/block_alias_test.cmi test/block_alias_test.cmj test/boolean_test.cmi test/boolean_test.cmj test/bs_MapInt_test.cmi test/bs_MapInt_test.cmj test/bs_abstract_test.cmi test/bs_abstract_test.cmj test/bs_array_test.cmi test/bs_array_test.cmj test/bs_auto_uncurry.cmi test/bs_auto_uncurry.cmj test/bs_auto_uncurry_test.cmi test/bs_auto_uncurry_test.cmj test/bs_float_test.cmi test/bs_float_test.cmj test/bs_hashmap_test.cmi test/bs_hashmap_test.cmj test/bs_hashset_int_test.cmi test/bs_hashset_int_test.cmj test/bs_hashtbl_string_test.cmi test/bs_hashtbl_string_test.cmj test/bs_ignore_effect.cmi test/bs_ignore_effect.cmj test/bs_ignore_test.cmi test/bs_ignore_test.cmj test/bs_int_test.cmi test/bs_int_test.cmj test/bs_list_test.cmi test/bs_list_test.cmj test/bs_map_set_dict_test.cmi test/bs_map_set_dict_test.cmj test/bs_map_test.cmi test/bs_map_test.cmj test/bs_min_max_test.cmi test/bs_min_max_test.cmj test/bs_mutable_set_test.cmi test/bs_mutable_set_test.cmj test/bs_node_string_buffer_test.cmi test/bs_node_string_buffer_test.cmj test/bs_poly_map_test.cmi test/bs_poly_map_test.cmj test/bs_poly_mutable_map_test.cmi test/bs_poly_mutable_map_test.cmj test/bs_poly_mutable_set_test.cmi test/bs_poly_mutable_set_test.cmj test/bs_poly_set_test.cmi test/bs_poly_set_test.cmj test/bs_qualified.cmi test/bs_qualified.cmj test/bs_queue_test.cmi test/bs_queue_test.cmj test/bs_rbset_int_bench.cmi test/bs_rbset_int_bench.cmj test/bs_rest_test.cmi test/bs_rest_test.cmj test/bs_set_bench.cmi test/bs_set_bench.cmj test/bs_set_int_test.cmi test/bs_set_int_test.cmj test/bs_sort_test.cmi test/bs_sort_test.cmj test/bs_splice_partial.cmi test/bs_splice_partial.cmj test/bs_stack_test.cmi test/bs_stack_test.cmj test/bs_string_test.cmi test/bs_string_test.cmj test/bs_unwrap_test.cmi test/bs_unwrap_test.cmj test/buffer_test.cmi test/buffer_test.cmj test/bytes_split_gpr_743_test.cmi test/bytes_split_gpr_743_test.cmj test/caml_compare_bigint_test.cmi test/caml_compare_bigint_test.cmj test/caml_compare_test.cmi test/caml_compare_test.cmj test/caml_format_test.cmi test/caml_format_test.cmj test/caml_sys_poly_fill_test.cmi test/caml_sys_poly_fill_test.cmj test/chain_code_test.cmi test/chain_code_test.cmj test/chn_test.cmi test/chn_test.cmj test/class_type_ffi_test.cmi test/class_type_ffi_test.cmj test/coercion_module_alias_test.cmi test/coercion_module_alias_test.cmj test/compare_test.cmi test/compare_test.cmj test/complete_parmatch_test.cmi test/complete_parmatch_test.cmj test/complex_if_test.cmi test/complex_if_test.cmj test/complex_test.cmi test/complex_test.cmj test/complex_while_loop.cmi test/complex_while_loop.cmj test/condition_compilation_test.cmi test/condition_compilation_test.cmj test/config1_test.cmi test/config1_test.cmj test/console_log_test.cmi test/console_log_test.cmj test/const_block_test.cmi test/const_block_test.cmj test/const_defs.cmi test/const_defs.cmj test/const_defs_test.cmi test/const_defs_test.cmj test/const_test.cmi test/const_test.cmj test/cont_int_fold_test.cmi test/cont_int_fold_test.cmj test/cps_test.cmi test/cps_test.cmj test/cross_module_inline_test.cmi test/cross_module_inline_test.cmj test/custom_error_test.cmi test/custom_error_test.cmj test/debug_keep_test.cmi test/debug_keep_test.cmj test/debug_mode_value.cmi test/debug_mode_value.cmj test/debug_tmp.cmi test/debug_tmp.cmj test/debugger_test.cmi test/debugger_test.cmj test/default_export_test.cmi test/default_export_test.cmj test/defunctor_make_test.cmi test/defunctor_make_test.cmj test/demo_int_map.cmi test/demo_int_map.cmj test/demo_page.cmi test/demo_page.cmj test/demo_pipe.cmi test/demo_pipe.cmj test/derive_dyntype.cmi test/derive_dyntype.cmj test/derive_projector_test.cmi test/derive_projector_test.cmj test/derive_type_test.cmi test/derive_type_test.cmj test/digest_test.cmi test/digest_test.cmj test/directives.cmi test/directives.cmj test/div_by_zero_test.cmi test/div_by_zero_test.cmj test/dollar_escape_test.cmi test/dollar_escape_test.cmj test/earger_curry_test.cmi test/earger_curry_test.cmj test/effect.cmi test/effect.cmj test/epsilon_test.cmi test/epsilon_test.cmj test/equal_box_test.cmi test/equal_box_test.cmj test/equal_exception_test.cmi test/equal_exception_test.cmj test/equal_test.cmi test/equal_test.cmj test/es6_export.cmi test/es6_export.cmj test/es6_import.cmi test/es6_import.cmj test/es6_module_test.cmi test/es6_module_test.cmj test/escape_esmodule.cmi test/escape_esmodule.cmj test/esmodule_ref.cmi test/esmodule_ref.cmj test/event_ffi.cmi test/event_ffi.cmj test/exception_alias.cmi test/exception_alias.cmj test/exception_def.cmi test/exception_def.cmj test/exception_raise_test.cmi test/exception_raise_test.cmj test/exception_rebind_test.cmi test/exception_rebind_test.cmj test/exception_rebound_err_test.cmi test/exception_rebound_err_test.cmj test/exception_value_test.cmi test/exception_value_test.cmj test/exn_error_pattern.cmi test/exn_error_pattern.cmj test/exponentiation_precedence_test.cmi test/exponentiation_precedence_test.cmj test/export_keyword.cmi test/export_keyword.cmj test/ext_array_test.cmi test/ext_array_test.cmj test/ext_bytes_test.cmi test/ext_bytes_test.cmj test/ext_filename_test.cmi test/ext_filename_test.cmj test/ext_list_test.cmi test/ext_list_test.cmj test/ext_pervasives_test.cmi test/ext_pervasives_test.cmj test/ext_string_test.cmi test/ext_string_test.cmj test/ext_sys_test.cmi test/ext_sys_test.cmj test/extensible_variant_test.cmi test/extensible_variant_test.cmj test/external_polyfill_test.cmi test/external_polyfill_test.cmj test/external_ppx.cmi test/external_ppx.cmj test/external_ppx2.cmi test/external_ppx2.cmj test/fail_comp.cmi test/fail_comp.cmj test/ffi_arity_test.cmi test/ffi_arity_test.cmj test/ffi_array_test.cmi test/ffi_array_test.cmj test/ffi_js_test.cmi test/ffi_js_test.cmj test/ffi_splice_test.cmi test/ffi_splice_test.cmj test/ffi_test.cmi test/ffi_test.cmj test/fib.cmi test/fib.cmj test/flattern_order_test.cmi test/flattern_order_test.cmj test/flexible_array_test.cmi test/flexible_array_test.cmj test/float_array.cmi test/float_array.cmj test/float_of_bits_test.cmi test/float_of_bits_test.cmj test/float_record.cmi test/float_record.cmj test/float_test.cmi test/float_test.cmj test/floatarray_test.cmi test/floatarray_test.cmj test/flow_parser_reg_test.cmi test/flow_parser_reg_test.cmj test/for_loop_test.cmi test/for_loop_test.cmj test/for_side_effect_test.cmi test/for_side_effect_test.cmj test/format_regression.cmi test/format_regression.cmj test/format_test.cmi test/format_test.cmj test/fs_test.cmi test/fs_test.cmj test/fun_pattern_match.cmi test/fun_pattern_match.cmj test/functor_app_test.cmi test/functor_app_test.cmj test/functor_def.cmi test/functor_def.cmj test/functor_ffi.cmi test/functor_ffi.cmj test/functor_inst.cmi test/functor_inst.cmj test/functors.cmi test/functors.cmj test/gbk.cmi test/gbk.cmj test/genlex_test.cmi test/genlex_test.cmj test/gentTypeReTest.cmi test/gentTypeReTest.cmj test/global_exception_regression_test.cmi test/global_exception_regression_test.cmj test/global_mangles.cmi test/global_mangles.cmj test/global_module_alias_test.cmi test/global_module_alias_test.cmj test/google_closure_test.cmi test/google_closure_test.cmj test/gpr496_test.cmi test/gpr496_test.cmj test/gpr_1072.cmi test/gpr_1072.cmj test/gpr_1072_reg.cmi test/gpr_1072_reg.cmj test/gpr_1150.cmi test/gpr_1150.cmj test/gpr_1154_test.cmi test/gpr_1154_test.cmj test/gpr_1170.cmi test/gpr_1170.cmj test/gpr_1240_missing_unbox.cmi test/gpr_1240_missing_unbox.cmj test/gpr_1245_test.cmi test/gpr_1245_test.cmj test/gpr_1268.cmi test/gpr_1268.cmj test/gpr_1409_test.cmi test/gpr_1409_test.cmj test/gpr_1423_app_test.cmi test/gpr_1423_app_test.cmj test/gpr_1423_nav.cmi test/gpr_1423_nav.cmj test/gpr_1438.cmi test/gpr_1438.cmj test/gpr_1481.cmi test/gpr_1481.cmj test/gpr_1484.cmi test/gpr_1484.cmj test/gpr_1503_test.cmi test/gpr_1503_test.cmj test/gpr_1539_test.cmi test/gpr_1539_test.cmj test/gpr_1658_test.cmi test/gpr_1658_test.cmj test/gpr_1667_test.cmi test/gpr_1667_test.cmj test/gpr_1692_test.cmi test/gpr_1692_test.cmj test/gpr_1698_test.cmi test/gpr_1698_test.cmj test/gpr_1701_test.cmi test/gpr_1701_test.cmj test/gpr_1716_test.cmi test/gpr_1716_test.cmj test/gpr_1717_test.cmi test/gpr_1717_test.cmj test/gpr_1728_test.cmi test/gpr_1728_test.cmj test/gpr_1749_test.cmi test/gpr_1749_test.cmj test/gpr_1759_test.cmi test/gpr_1759_test.cmj test/gpr_1760_test.cmi test/gpr_1760_test.cmj test/gpr_1762_test.cmi test/gpr_1762_test.cmj test/gpr_1817_test.cmi test/gpr_1817_test.cmj test/gpr_1822_test.cmi test/gpr_1822_test.cmj test/gpr_1891_test.cmi test/gpr_1891_test.cmj test/gpr_1943_test.cmi test/gpr_1943_test.cmj test/gpr_1946_test.cmi test/gpr_1946_test.cmj test/gpr_2316_test.cmi test/gpr_2316_test.cmj test/gpr_2352_test.cmi test/gpr_2352_test.cmj test/gpr_2413_test.cmi test/gpr_2413_test.cmj test/gpr_2474.cmi test/gpr_2474.cmj test/gpr_2487.cmi test/gpr_2487.cmj test/gpr_2503_test.cmi test/gpr_2503_test.cmj test/gpr_2608_test.cmi test/gpr_2608_test.cmj test/gpr_2614_test.cmi test/gpr_2614_test.cmj test/gpr_2633_test.cmi test/gpr_2633_test.cmj test/gpr_2642_test.cmi test/gpr_2642_test.cmj test/gpr_2652_test.cmi test/gpr_2652_test.cmj test/gpr_2682_test.cmi test/gpr_2682_test.cmj test/gpr_2700_test.cmi test/gpr_2700_test.cmj test/gpr_2731_test.cmi test/gpr_2731_test.cmj test/gpr_2789_test.cmi test/gpr_2789_test.cmj test/gpr_2931_test.cmi test/gpr_2931_test.cmj test/gpr_3142_test.cmi test/gpr_3142_test.cmj test/gpr_3154_test.cmi test/gpr_3154_test.cmj test/gpr_3209_test.cmi test/gpr_3209_test.cmj test/gpr_3492_test.cmi test/gpr_3492_test.cmj test/gpr_3519_jsx_test.cmi test/gpr_3519_jsx_test.cmj test/gpr_3519_test.cmi test/gpr_3519_test.cmj test/gpr_3536_test.cmi test/gpr_3536_test.cmj test/gpr_3546_test.cmi test/gpr_3546_test.cmj test/gpr_3548_test.cmi test/gpr_3548_test.cmj test/gpr_3549_test.cmi test/gpr_3549_test.cmj test/gpr_3566_drive_test.cmi test/gpr_3566_drive_test.cmj test/gpr_3566_test.cmi test/gpr_3566_test.cmj test/gpr_3595_test.cmi test/gpr_3595_test.cmj test/gpr_3609_test.cmi test/gpr_3609_test.cmj test/gpr_3697_test.cmi test/gpr_3697_test.cmj test/gpr_373_test.cmi test/gpr_373_test.cmj test/gpr_3770_test.cmi test/gpr_3770_test.cmj test/gpr_3852_alias.cmi test/gpr_3852_alias.cmj test/gpr_3852_alias_reify.cmi test/gpr_3852_alias_reify.cmj test/gpr_3852_effect.cmi test/gpr_3852_effect.cmj test/gpr_3865.cmi test/gpr_3865.cmj test/gpr_3865_bar.cmi test/gpr_3865_bar.cmj test/gpr_3865_foo.cmi test/gpr_3865_foo.cmj test/gpr_3875_test.cmi test/gpr_3875_test.cmj test/gpr_3877_test.cmi test/gpr_3877_test.cmj test/gpr_3895_test.cmi test/gpr_3895_test.cmj test/gpr_3897_test.cmi test/gpr_3897_test.cmj test/gpr_3931_test.cmi test/gpr_3931_test.cmj test/gpr_3980_test.cmi test/gpr_3980_test.cmj test/gpr_4025_test.cmi test/gpr_4025_test.cmj test/gpr_405_test.cmi test/gpr_405_test.cmj test/gpr_4069_test.cmi test/gpr_4069_test.cmj test/gpr_4265_test.cmi test/gpr_4265_test.cmj test/gpr_4274_test.cmi test/gpr_4274_test.cmj test/gpr_4280_test.cmi test/gpr_4280_test.cmj test/gpr_4407_test.cmi test/gpr_4407_test.cmj test/gpr_441.cmi test/gpr_441.cmj test/gpr_4442_test.cmi test/gpr_4442_test.cmj test/gpr_4491_test.cmi test/gpr_4491_test.cmj test/gpr_4494_test.cmi test/gpr_4494_test.cmj test/gpr_4519_test.cmi test/gpr_4519_test.cmj test/gpr_459_test.cmi test/gpr_459_test.cmj test/gpr_4632.cmi test/gpr_4632.cmj test/gpr_4639_test.cmi test/gpr_4639_test.cmj test/gpr_4900_test.cmi test/gpr_4900_test.cmj test/gpr_4924_test.cmi test/gpr_4924_test.cmj test/gpr_4931.cmi test/gpr_4931.cmj test/gpr_4931_allow.cmi test/gpr_4931_allow.cmj test/gpr_5071_test.cmi test/gpr_5071_test.cmj test/gpr_5169_test.cmi test/gpr_5169_test.cmj test/gpr_5218_test.cmi test/gpr_5218_test.cmj test/gpr_5280_optimize_test.cmi test/gpr_5280_optimize_test.cmj test/gpr_5312.cmi test/gpr_5312.cmj test/gpr_5557.cmi test/gpr_5557.cmj test/gpr_5753.cmi test/gpr_5753.cmj test/gpr_658.cmi test/gpr_658.cmj test/gpr_858_test.cmi test/gpr_858_test.cmj test/gpr_858_unit2_test.cmi test/gpr_858_unit2_test.cmj test/gpr_904_test.cmi test/gpr_904_test.cmj test/gpr_974_test.cmi test/gpr_974_test.cmj test/gpr_977_test.cmi test/gpr_977_test.cmj test/gpr_return_type_unused_attribute.cmi test/gpr_return_type_unused_attribute.cmj test/gray_code_test.cmi test/gray_code_test.cmj test/guide_for_ext.cmi test/guide_for_ext.cmj test/hamming_test.cmi test/hamming_test.cmj test/hash_collision_test.cmi test/hash_collision_test.cmj test/hash_sugar_desugar.cmi test/hash_sugar_desugar.cmj test/hash_test.cmi test/hash_test.cmj test/hashtbl_test.cmi test/hashtbl_test.cmj test/hello.foo.cmi test/hello.foo.cmj test/hello_res.cmi test/hello_res.cmj test/ignore_test.cmi test/ignore_test.cmj test/imm_map_bench.cmi test/imm_map_bench.cmj test/include_side_effect.cmi test/include_side_effect.cmj test/include_side_effect_free.cmi test/include_side_effect_free.cmj test/incomplete_toplevel_test.cmi test/incomplete_toplevel_test.cmj test/infer_type_test.cmi test/infer_type_test.cmj test/inline_const.cmi test/inline_const.cmj test/inline_const_test.cmi test/inline_const_test.cmj test/inline_edge_cases.cmi test/inline_edge_cases.cmj test/inline_map2_test.cmi test/inline_map2_test.cmj test/inline_map_demo.cmi test/inline_map_demo.cmj test/inline_map_test.cmi test/inline_map_test.cmj test/inline_record_test.cmi test/inline_record_test.cmj test/inline_regression_test.cmi test/inline_regression_test.cmj test/inline_string_test.cmi test/inline_string_test.cmj test/inner_call.cmi test/inner_call.cmj test/inner_define.cmi test/inner_define.cmj test/inner_unused.cmi test/inner_unused.cmj test/installation_test.cmi test/installation_test.cmj test/int32_test.cmi test/int32_test.cmj test/int64_mul_div_test.cmi test/int64_mul_div_test.cmj test/int64_string_bench.cmi test/int64_string_bench.cmj test/int64_string_test.cmi test/int64_string_test.cmj test/int64_test.cmi test/int64_test.cmj test/int_hashtbl_test.cmi test/int_hashtbl_test.cmj test/int_map.cmi test/int_map.cmj test/int_overflow_test.cmi test/int_overflow_test.cmj test/int_poly_var.cmi test/int_poly_var.cmj test/int_switch_test.cmi test/int_switch_test.cmj test/internal_unused_test.cmi test/internal_unused_test.cmj test/io_test.cmi test/io_test.cmj test/js_array_test.cmi test/js_array_test.cmj test/js_bool_test.cmi test/js_bool_test.cmj test/js_cast_test.cmi test/js_cast_test.cmj test/js_date_test.cmi test/js_date_test.cmj test/js_dict_test.cmi test/js_dict_test.cmj test/js_exception_catch_test.cmi test/js_exception_catch_test.cmj test/js_float_test.cmi test/js_float_test.cmj test/js_global_test.cmi test/js_global_test.cmj test/js_int_test.cmi test/js_int_test.cmj test/js_json_test.cmi test/js_json_test.cmj test/js_list_test.cmi test/js_list_test.cmj test/js_math_test.cmi test/js_math_test.cmj test/js_null_test.cmi test/js_null_test.cmj test/js_null_undefined_test.cmi test/js_null_undefined_test.cmj test/js_nullable_test.cmi test/js_nullable_test.cmj test/js_obj_test.cmi test/js_obj_test.cmj test/js_option_test.cmi test/js_option_test.cmj test/js_promise_basic_test.cmi test/js_promise_basic_test.cmj test/js_re_test.cmi test/js_re_test.cmj test/js_string_test.cmi test/js_string_test.cmj test/js_typed_array_test.cmi test/js_typed_array_test.cmj test/js_undefined_test.cmi test/js_undefined_test.cmj test/js_val.cmi test/js_val.cmj test/jsoo_400_test.cmi test/jsoo_400_test.cmj test/jsoo_485_test.cmi test/jsoo_485_test.cmj test/jsxv4_newtype.cmi test/jsxv4_newtype.cmj test/key_word_property.cmi test/key_word_property.cmj test/key_word_property2.cmi test/key_word_property2.cmj test/key_word_property_plus_test.cmi test/key_word_property_plus_test.cmj test/label_uncurry.cmi test/label_uncurry.cmj test/large_integer_pat.cmi test/large_integer_pat.cmj test/large_record_duplication_test.cmi test/large_record_duplication_test.cmj test/largest_int_flow.cmi test/largest_int_flow.cmj test/lazy_demo.cmi test/lazy_demo.cmj test/lazy_test.cmi test/lazy_test.cmj test/lib_js_test.cmi test/lib_js_test.cmj test/libarg_test.cmi test/libarg_test.cmj test/libqueue_test.cmi test/libqueue_test.cmj test/limits_test.cmi test/limits_test.cmj test/list_stack.cmi test/list_stack.cmj test/list_test.cmi test/list_test.cmj test/local_exception_test.cmi test/local_exception_test.cmj test/loop_regression_test.cmi test/loop_regression_test.cmj test/loop_suites_test.cmi test/loop_suites_test.cmj test/map_find_test.cmi test/map_find_test.cmj test/map_test.cmi test/map_test.cmj test/mario_game.cmi test/mario_game.cmj test/marshal.cmi test/marshal.cmj test/meth_annotation.cmi test/meth_annotation.cmj test/method_name_test.cmi test/method_name_test.cmj test/method_string_name.cmi test/method_string_name.cmj test/minimal_test.cmi test/minimal_test.cmj test/miss_colon_test.cmi test/miss_colon_test.cmj test/mock_mt.cmi test/mock_mt.cmj test/module_alias_test.cmi test/module_alias_test.cmj test/module_as_class_ffi.cmi test/module_as_class_ffi.cmj test/module_as_function.cmi test/module_as_function.cmj test/module_missing_conversion.cmi test/module_missing_conversion.cmj test/module_parameter_test.cmi test/module_parameter_test.cmj test/module_splice_test.cmi test/module_splice_test.cmj test/more_poly_variant_test.cmi test/more_poly_variant_test.cmj test/more_uncurry.cmi test/more_uncurry.cmj test/mpr_6033_test.cmi test/mpr_6033_test.cmj test/mt.cmi test/mt.cmj test/mt_global.cmi test/mt_global.cmj test/mutable_obj_test.cmi test/mutable_obj_test.cmj test/mutable_uncurry_test.cmi test/mutable_uncurry_test.cmj test/mutual_non_recursive_type.cmi test/mutual_non_recursive_type.cmj test/name_mangle_test.cmi test/name_mangle_test.cmj test/nested_include.cmi test/nested_include.cmj test/nested_module_alias.cmi test/nested_module_alias.cmj test/nested_obj_literal.cmi test/nested_obj_literal.cmj test/nested_obj_test.cmi test/nested_obj_test.cmj test/nested_pattern_match_test.cmi test/nested_pattern_match_test.cmj test/noassert.cmi test/noassert.cmj test/node_fs_test.cmi test/node_fs_test.cmj test/node_path_test.cmi test/node_path_test.cmj test/null_list_test.cmi test/null_list_test.cmj test/number_lexer.cmi test/number_lexer.cmj test/obj_literal_ppx.cmi test/obj_literal_ppx.cmj test/obj_literal_ppx_test.cmi test/obj_literal_ppx_test.cmj test/obj_magic_test.cmi test/obj_magic_test.cmj test/obj_type_test.cmi test/obj_type_test.cmj test/ocaml_re_test.cmi test/ocaml_re_test.cmj test/of_string_test.cmi test/of_string_test.cmj test/offset.cmi test/offset.cmj test/option_encoding_test.cmi test/option_encoding_test.cmj test/option_record_none_test.cmi test/option_record_none_test.cmj test/option_repr_test.cmi test/option_repr_test.cmj test/optional_ffi_test.cmi test/optional_ffi_test.cmj test/optional_regression_test.cmi test/optional_regression_test.cmj test/pipe_send_readline.cmi test/pipe_send_readline.cmj test/pipe_syntax.cmi test/pipe_syntax.cmj test/poly_empty_array.cmi test/poly_empty_array.cmj test/poly_variant_test.cmi test/poly_variant_test.cmj test/polymorphic_raw_test.cmi test/polymorphic_raw_test.cmj test/polymorphism_test.cmi test/polymorphism_test.cmj test/polyvar_convert.cmi test/polyvar_convert.cmj test/polyvar_test.cmi test/polyvar_test.cmj test/ppx_apply_test.cmi test/ppx_apply_test.cmj test/pq_test.cmi test/pq_test.cmj test/pr6726.cmi test/pr6726.cmj test/pr_regression_test.cmi test/pr_regression_test.cmj test/prepend_data_ffi.cmi test/prepend_data_ffi.cmj test/primitive_reg_test.cmi test/primitive_reg_test.cmj test/print_alpha_test.cmi test/print_alpha_test.cmj test/promise_catch_test.cmi test/promise_catch_test.cmj test/queue_402.cmi test/queue_402.cmj test/queue_test.cmi test/queue_test.cmj test/random_test.cmi test/random_test.cmj test/raw_hash_tbl_bench.cmi test/raw_hash_tbl_bench.cmj test/raw_output_test.cmi test/raw_output_test.cmj test/raw_pure_test.cmi test/raw_pure_test.cmj test/rbset.cmi test/rbset.cmj test/react.cmi test/react.cmj test/reactDOMRe.cmi test/reactDOMRe.cmj test/reactDOMServerRe.cmi test/reactDOMServerRe.cmj test/reactEvent.cmi test/reactEvent.cmj test/reactTestUtils.cmi test/reactTestUtils.cmj test/reasonReact.cmi test/reasonReact.cmj test/reasonReactCompat.cmi test/reasonReactCompat.cmj test/reasonReactOptimizedCreateClass.cmi test/reasonReactOptimizedCreateClass.cmj test/reasonReactRouter.cmi test/reasonReactRouter.cmj test/rebind_module.cmi test/rebind_module.cmj test/rebind_module_test.cmi test/rebind_module_test.cmj test/rec_array_test.cmi test/rec_array_test.cmj test/rec_fun_test.cmi test/rec_fun_test.cmj test/rec_module_opt.cmi test/rec_module_opt.cmj test/rec_module_test.cmi test/rec_module_test.cmj test/rec_value_test.cmi test/rec_value_test.cmj test/record_debug_test.cmi test/record_debug_test.cmj test/record_extension_test.cmi test/record_extension_test.cmj test/record_name_test.cmi test/record_name_test.cmj test/record_regression.cmi test/record_regression.cmj test/record_with_test.cmi test/record_with_test.cmj test/recursive_module.cmi test/recursive_module.cmj test/recursive_module_test.cmi test/recursive_module_test.cmj test/recursive_react_component.cmi test/recursive_react_component.cmj test/recursive_records_test.cmi test/recursive_records_test.cmj test/recursive_unbound_module_test.cmi test/recursive_unbound_module_test.cmj test/regression_print.cmi test/regression_print.cmj test/relative_path.cmi test/relative_path.cmj test/res_debug.cmi test/res_debug.cmj test/return_check.cmi test/return_check.cmj test/runtime_encoding_test.cmi test/runtime_encoding_test.cmj test/set_annotation.cmi test/set_annotation.cmj test/set_gen.cmi test/set_gen.cmj test/sexp.cmi test/sexp.cmj test/sexpm.cmi test/sexpm.cmj test/sexpm_test.cmi test/sexpm_test.cmj test/side_effect.cmi test/side_effect.cmj test/side_effect_free.cmi test/side_effect_free.cmj test/simple_derive_test.cmi test/simple_derive_test.cmj test/simple_derive_use.cmi test/simple_derive_use.cmj test/simple_lexer_test.cmi test/simple_lexer_test.cmj test/simplify_lambda_632o.cmi test/simplify_lambda_632o.cmj test/single_module_alias.cmi test/single_module_alias.cmj test/singular_unit_test.cmi test/singular_unit_test.cmj test/small_inline_test.cmi test/small_inline_test.cmj test/splice_test.cmi test/splice_test.cmj test/stack_comp_test.cmi test/stack_comp_test.cmj test/stack_test.cmi test/stack_test.cmj test/stream_parser_test.cmi test/stream_parser_test.cmj test/string_bound_get_test.cmi test/string_bound_get_test.cmj test/string_constant_compare.cmi test/string_constant_compare.cmj test/string_get_set_test.cmi test/string_get_set_test.cmj test/string_literal_print_test.cmi test/string_literal_print_test.cmj test/string_runtime_test.cmi test/string_runtime_test.cmj test/string_set.cmi test/string_set.cmj test/string_set_test.cmi test/string_set_test.cmj test/string_test.cmi test/string_test.cmj test/string_unicode_test.cmi test/string_unicode_test.cmj test/stringmatch_test.cmi test/stringmatch_test.cmj test/submodule.cmi test/submodule.cmj test/submodule_call.cmi test/submodule_call.cmj test/switch_case_test.cmi test/switch_case_test.cmj test/switch_string.cmi test/switch_string.cmj test/tailcall_inline_test.cmi test/tailcall_inline_test.cmj test/template.cmi test/template.cmj test/test.cmi test/test.cmj test/test2.cmi test/test2.cmj test/test_alias.cmi test/test_alias.cmj test/test_ari.cmi test/test_ari.cmj test/test_array.cmi test/test_array.cmj test/test_array_append.cmi test/test_array_append.cmj test/test_array_primitive.cmi test/test_array_primitive.cmj test/test_bool_equal.cmi test/test_bool_equal.cmj test/test_bs_this.cmi test/test_bs_this.cmj test/test_bug.cmi test/test_bug.cmj test/test_bytes.cmi test/test_bytes.cmj test/test_case_opt_collision.cmi test/test_case_opt_collision.cmj test/test_case_set.cmi test/test_case_set.cmj test/test_char.cmi test/test_char.cmj test/test_closure.cmi test/test_closure.cmj test/test_common.cmi test/test_common.cmj test/test_const_elim.cmi test/test_const_elim.cmj test/test_const_propogate.cmi test/test_const_propogate.cmj test/test_cpp.cmi test/test_cpp.cmj test/test_cps.cmi test/test_cps.cmj test/test_demo.cmi test/test_demo.cmj test/test_dup_param.cmi test/test_dup_param.cmj test/test_eq.cmi test/test_eq.cmj test/test_exception.cmi test/test_exception.cmj test/test_exception_escape.cmi test/test_exception_escape.cmj test/test_export2.cmi test/test_export2.cmj test/test_external.cmi test/test_external.cmj test/test_external_unit.cmi test/test_external_unit.cmj test/test_ffi.cmi test/test_ffi.cmj test/test_fib.cmi test/test_fib.cmj test/test_filename.cmi test/test_filename.cmj test/test_for_loop.cmi test/test_for_loop.cmj test/test_for_map.cmi test/test_for_map.cmj test/test_for_map2.cmi test/test_for_map2.cmj test/test_format.cmi test/test_format.cmj test/test_formatter.cmi test/test_formatter.cmj test/test_functor_dead_code.cmi test/test_functor_dead_code.cmj test/test_generative_module.cmi test/test_generative_module.cmj test/test_global_print.cmi test/test_global_print.cmj test/test_google_closure.cmi test/test_google_closure.cmj test/test_include.cmi test/test_include.cmj test/test_incomplete.cmi test/test_incomplete.cmj test/test_incr_ref.cmi test/test_incr_ref.cmj test/test_int_map_find.cmi test/test_int_map_find.cmj test/test_internalOO.cmi test/test_internalOO.cmj test/test_is_js.cmi test/test_is_js.cmj test/test_js_ffi.cmi test/test_js_ffi.cmj test/test_let.cmi test/test_let.cmj test/test_list.cmi test/test_list.cmj test/test_literal.cmi test/test_literal.cmj test/test_literals.cmi test/test_literals.cmj test/test_match_exception.cmi test/test_match_exception.cmj test/test_mutliple.cmi test/test_mutliple.cmj test/test_nat64.cmi test/test_nat64.cmj test/test_nested_let.cmi test/test_nested_let.cmj test/test_nested_print.cmi test/test_nested_print.cmj test/test_non_export.cmi test/test_non_export.cmj test/test_nullary.cmi test/test_nullary.cmj test/test_obj.cmi test/test_obj.cmj test/test_obj_simple_ffi.cmi test/test_obj_simple_ffi.cmj test/test_order.cmi test/test_order.cmj test/test_order_tailcall.cmi test/test_order_tailcall.cmj test/test_other_exn.cmi test/test_other_exn.cmj test/test_pack.cmi test/test_pack.cmj test/test_per.cmi test/test_per.cmj test/test_pervasive.cmi test/test_pervasive.cmj test/test_pervasives2.cmi test/test_pervasives2.cmj test/test_pervasives3.cmi test/test_pervasives3.cmj test/test_primitive.cmi test/test_primitive.cmj test/test_ramification.cmi test/test_ramification.cmj test/test_react.cmi test/test_react.cmj test/test_react_case.cmi test/test_react_case.cmj test/test_regex.cmi test/test_regex.cmj test/test_require.cmi test/test_require.cmj test/test_runtime_encoding.cmi test/test_runtime_encoding.cmj test/test_scope.cmi test/test_scope.cmj test/test_seq.cmi test/test_seq.cmj test/test_set.cmi test/test_set.cmj test/test_side_effect_functor.cmi test/test_side_effect_functor.cmj test/test_simple_include.cmi test/test_simple_include.cmj test/test_simple_pattern_match.cmi test/test_simple_pattern_match.cmj test/test_simple_ref.cmi test/test_simple_ref.cmj test/test_simple_tailcall.cmi test/test_simple_tailcall.cmj test/test_small.cmi test/test_small.cmj test/test_sprintf.cmi test/test_sprintf.cmj test/test_stack.cmi test/test_stack.cmj test/test_static_catch_ident.cmi test/test_static_catch_ident.cmj test/test_string.cmi test/test_string.cmj test/test_string_case.cmi test/test_string_case.cmj test/test_string_const.cmi test/test_string_const.cmj test/test_string_map.cmi test/test_string_map.cmj test/test_string_switch.cmi test/test_string_switch.cmj test/test_switch.cmi test/test_switch.cmj test/test_trywith.cmi test/test_trywith.cmj test/test_tuple.cmi test/test_tuple.cmj test/test_tuple_destructring.cmi test/test_tuple_destructring.cmj test/test_type_based_arity.cmi test/test_type_based_arity.cmj test/test_u.cmi test/test_u.cmj test/test_unknown.cmi test/test_unknown.cmj test/test_unsafe_cmp.cmi test/test_unsafe_cmp.cmj test/test_unsafe_obj_ffi.cmi test/test_unsafe_obj_ffi.cmj test/test_unsafe_obj_ffi_ppx.cmi test/test_unsafe_obj_ffi_ppx.cmj test/test_unsupported_primitive.cmi test/test_unsupported_primitive.cmj test/test_while_closure.cmi test/test_while_closure.cmj test/test_while_side_effect.cmi test/test_while_side_effect.cmj test/test_zero_nullable.cmi test/test_zero_nullable.cmj test/then_mangle_test.cmi test/then_mangle_test.cmj test/ticker.cmi test/ticker.cmj test/to_string_test.cmi test/to_string_test.cmj test/topsort_test.cmi test/topsort_test.cmj test/tramp_fib.cmi test/tramp_fib.cmj test/tuple_alloc.cmi test/tuple_alloc.cmj test/type_disambiguate.cmi test/type_disambiguate.cmj test/typeof_test.cmi test/typeof_test.cmj test/ui_defs.cmi test/unboxed_attribute.cmi test/unboxed_attribute.cmj test/unboxed_attribute_test.cmi test/unboxed_attribute_test.cmj test/unboxed_crash.cmi test/unboxed_crash.cmj test/unboxed_use_case.cmi test/unboxed_use_case.cmj test/uncurried_cast.cmi test/uncurried_cast.cmj test/uncurried_default.args.cmi test/uncurried_default.args.cmj test/uncurried_pipe.cmi test/uncurried_pipe.cmj test/uncurry_external_test.cmi test/uncurry_external_test.cmj test/uncurry_glob_test.cmi test/uncurry_glob_test.cmj test/uncurry_test.cmi test/uncurry_test.cmj test/undef_regression2_test.cmi test/undef_regression2_test.cmj test/undef_regression_test.cmi test/undef_regression_test.cmj test/undefine_conditional.cmi test/undefine_conditional.cmj test/unicode_type_error.cmi test/unicode_type_error.cmj test/unit_undefined_test.cmi test/unit_undefined_test.cmj test/unitest_string.cmi test/unitest_string.cmj test/unsafe_full_apply_primitive.cmi test/unsafe_full_apply_primitive.cmj test/unsafe_ppx_test.cmi test/unsafe_ppx_test.cmj test/unsafe_this.cmi test/unsafe_this.cmj test/update_record_test.cmi test/update_record_test.cmj test/utf8_decode_test.cmi test/utf8_decode_test.cmj test/variant.cmi test/variant.cmj test/variantsMatching.cmi test/variantsMatching.cmj test/watch_test.cmi test/watch_test.cmj test/webpack_config.cmi test/webpack_config.cmj +o test : phony test/406_primitive_test.cmi test/406_primitive_test.cmj test/EmptyRecord.cmi test/EmptyRecord.cmj test/SafePromises.cmi test/SafePromises.cmj test/UncurriedAlways.cmi test/UncurriedAlways.cmj test/UncurriedExternals.cmi test/UncurriedExternals.cmj test/UncurriedPervasives.cmi test/UncurriedPervasives.cmj test/UntaggedVariants.cmi test/UntaggedVariants.cmj test/a.cmi test/a.cmj test/a_filename_test.cmi test/a_filename_test.cmj test/a_list_test.cmi test/a_list_test.cmj test/a_recursive_type.cmi test/a_recursive_type.cmj test/a_scope_bug.cmi test/a_scope_bug.cmj test/a_string_test.cmi test/a_string_test.cmj test/abstract_type.cmi test/abstract_type.cmj test/adt_optimize_test.cmi test/adt_optimize_test.cmj test/alias_default_value_test.cmi test/alias_default_value_test.cmj test/alias_test.cmi test/alias_test.cmj test/and_or_tailcall_test.cmi test/and_or_tailcall_test.cmj test/app_root_finder.cmi test/app_root_finder.cmj test/argv_test.cmi test/argv_test.cmj test/ari_regress_test.cmi test/ari_regress_test.cmj test/arith_lexer.cmi test/arith_lexer.cmj test/arith_parser.cmi test/arith_parser.cmj test/arith_syntax.cmi test/arith_syntax.cmj test/arity.cmi test/arity.cmj test/arity_deopt.cmi test/arity_deopt.cmj test/arity_infer.cmi test/arity_infer.cmj test/array_data_util.cmi test/array_data_util.cmj test/array_safe_get.cmi test/array_safe_get.cmj test/array_subtle_test.cmi test/array_subtle_test.cmj test/array_test.cmi test/array_test.cmj test/ast_abstract_test.cmi test/ast_abstract_test.cmj test/ast_mapper_unused_warning_test.cmi test/ast_mapper_unused_warning_test.cmj test/async_await.cmi test/async_await.cmj test/async_ideas.cmi test/async_ideas.cmj test/async_inline.cmi test/async_inline.cmj test/attr_test.cmi test/attr_test.cmj test/b.cmi test/b.cmj test/bal_set_mini.cmi test/bal_set_mini.cmj test/bang_primitive.cmi test/bang_primitive.cmj test/basic_module_test.cmi test/basic_module_test.cmj test/bb.cmi test/bb.cmj test/bdd.cmi test/bdd.cmj test/belt_internal_test.cmi test/belt_internal_test.cmj test/belt_result_alias_test.cmi test/belt_result_alias_test.cmj test/bench.cmi test/bench.cmj test/big_enum.cmi test/big_enum.cmj test/big_polyvar_test.cmi test/big_polyvar_test.cmj test/block_alias_test.cmi test/block_alias_test.cmj test/boolean_test.cmi test/boolean_test.cmj test/bs_MapInt_test.cmi test/bs_MapInt_test.cmj test/bs_abstract_test.cmi test/bs_abstract_test.cmj test/bs_array_test.cmi test/bs_array_test.cmj test/bs_auto_uncurry.cmi test/bs_auto_uncurry.cmj test/bs_auto_uncurry_test.cmi test/bs_auto_uncurry_test.cmj test/bs_float_test.cmi test/bs_float_test.cmj test/bs_hashmap_test.cmi test/bs_hashmap_test.cmj test/bs_hashset_int_test.cmi test/bs_hashset_int_test.cmj test/bs_hashtbl_string_test.cmi test/bs_hashtbl_string_test.cmj test/bs_ignore_effect.cmi test/bs_ignore_effect.cmj test/bs_ignore_test.cmi test/bs_ignore_test.cmj test/bs_int_test.cmi test/bs_int_test.cmj test/bs_list_test.cmi test/bs_list_test.cmj test/bs_map_set_dict_test.cmi test/bs_map_set_dict_test.cmj test/bs_map_test.cmi test/bs_map_test.cmj test/bs_min_max_test.cmi test/bs_min_max_test.cmj test/bs_mutable_set_test.cmi test/bs_mutable_set_test.cmj test/bs_node_string_buffer_test.cmi test/bs_node_string_buffer_test.cmj test/bs_poly_map_test.cmi test/bs_poly_map_test.cmj test/bs_poly_mutable_map_test.cmi test/bs_poly_mutable_map_test.cmj test/bs_poly_mutable_set_test.cmi test/bs_poly_mutable_set_test.cmj test/bs_poly_set_test.cmi test/bs_poly_set_test.cmj test/bs_qualified.cmi test/bs_qualified.cmj test/bs_queue_test.cmi test/bs_queue_test.cmj test/bs_rbset_int_bench.cmi test/bs_rbset_int_bench.cmj test/bs_rest_test.cmi test/bs_rest_test.cmj test/bs_set_bench.cmi test/bs_set_bench.cmj test/bs_set_int_test.cmi test/bs_set_int_test.cmj test/bs_sort_test.cmi test/bs_sort_test.cmj test/bs_splice_partial.cmi test/bs_splice_partial.cmj test/bs_stack_test.cmi test/bs_stack_test.cmj test/bs_string_test.cmi test/bs_string_test.cmj test/bs_unwrap_test.cmi test/bs_unwrap_test.cmj test/buffer_test.cmi test/buffer_test.cmj test/bytes_split_gpr_743_test.cmi test/bytes_split_gpr_743_test.cmj test/caml_compare_bigint_test.cmi test/caml_compare_bigint_test.cmj test/caml_compare_test.cmi test/caml_compare_test.cmj test/caml_format_test.cmi test/caml_format_test.cmj test/caml_sys_poly_fill_test.cmi test/caml_sys_poly_fill_test.cmj test/chain_code_test.cmi test/chain_code_test.cmj test/chn_test.cmi test/chn_test.cmj test/class_type_ffi_test.cmi test/class_type_ffi_test.cmj test/coercion_module_alias_test.cmi test/coercion_module_alias_test.cmj test/compare_test.cmi test/compare_test.cmj test/complete_parmatch_test.cmi test/complete_parmatch_test.cmj test/complex_if_test.cmi test/complex_if_test.cmj test/complex_test.cmi test/complex_test.cmj test/complex_while_loop.cmi test/complex_while_loop.cmj test/condition_compilation_test.cmi test/condition_compilation_test.cmj test/config1_test.cmi test/config1_test.cmj test/console_log_test.cmi test/console_log_test.cmj test/const_block_test.cmi test/const_block_test.cmj test/const_defs.cmi test/const_defs.cmj test/const_defs_test.cmi test/const_defs_test.cmj test/const_test.cmi test/const_test.cmj test/cont_int_fold_test.cmi test/cont_int_fold_test.cmj test/cps_test.cmi test/cps_test.cmj test/cross_module_inline_test.cmi test/cross_module_inline_test.cmj test/custom_error_test.cmi test/custom_error_test.cmj test/debug_keep_test.cmi test/debug_keep_test.cmj test/debug_mode_value.cmi test/debug_mode_value.cmj test/debug_tmp.cmi test/debug_tmp.cmj test/debugger_test.cmi test/debugger_test.cmj test/default_export_test.cmi test/default_export_test.cmj test/defunctor_make_test.cmi test/defunctor_make_test.cmj test/demo_int_map.cmi test/demo_int_map.cmj test/demo_page.cmi test/demo_page.cmj test/demo_pipe.cmi test/demo_pipe.cmj test/derive_dyntype.cmi test/derive_dyntype.cmj test/derive_projector_test.cmi test/derive_projector_test.cmj test/derive_type_test.cmi test/derive_type_test.cmj test/digest_test.cmi test/digest_test.cmj test/directives.cmi test/directives.cmj test/div_by_zero_test.cmi test/div_by_zero_test.cmj test/dollar_escape_test.cmi test/dollar_escape_test.cmj test/earger_curry_test.cmi test/earger_curry_test.cmj test/effect.cmi test/effect.cmj test/epsilon_test.cmi test/epsilon_test.cmj test/equal_box_test.cmi test/equal_box_test.cmj test/equal_exception_test.cmi test/equal_exception_test.cmj test/equal_test.cmi test/equal_test.cmj test/es6_export.cmi test/es6_export.cmj test/es6_import.cmi test/es6_import.cmj test/es6_module_test.cmi test/es6_module_test.cmj test/escape_esmodule.cmi test/escape_esmodule.cmj test/esmodule_ref.cmi test/esmodule_ref.cmj test/event_ffi.cmi test/event_ffi.cmj test/exception_alias.cmi test/exception_alias.cmj test/exception_def.cmi test/exception_def.cmj test/exception_raise_test.cmi test/exception_raise_test.cmj test/exception_rebind_test.cmi test/exception_rebind_test.cmj test/exception_rebound_err_test.cmi test/exception_rebound_err_test.cmj test/exception_value_test.cmi test/exception_value_test.cmj test/exn_error_pattern.cmi test/exn_error_pattern.cmj test/exponentiation_precedence_test.cmi test/exponentiation_precedence_test.cmj test/export_keyword.cmi test/export_keyword.cmj test/ext_array_test.cmi test/ext_array_test.cmj test/ext_bytes_test.cmi test/ext_bytes_test.cmj test/ext_filename_test.cmi test/ext_filename_test.cmj test/ext_list_test.cmi test/ext_list_test.cmj test/ext_pervasives_test.cmi test/ext_pervasives_test.cmj test/ext_string_test.cmi test/ext_string_test.cmj test/ext_sys_test.cmi test/ext_sys_test.cmj test/extensible_variant_test.cmi test/extensible_variant_test.cmj test/external_polyfill_test.cmi test/external_polyfill_test.cmj test/external_ppx.cmi test/external_ppx.cmj test/external_ppx2.cmi test/external_ppx2.cmj test/fail_comp.cmi test/fail_comp.cmj test/ffi_arity_test.cmi test/ffi_arity_test.cmj test/ffi_array_test.cmi test/ffi_array_test.cmj test/ffi_js_test.cmi test/ffi_js_test.cmj test/ffi_splice_test.cmi test/ffi_splice_test.cmj test/ffi_test.cmi test/ffi_test.cmj test/fib.cmi test/fib.cmj test/flattern_order_test.cmi test/flattern_order_test.cmj test/flexible_array_test.cmi test/flexible_array_test.cmj test/float_array.cmi test/float_array.cmj test/float_of_bits_test.cmi test/float_of_bits_test.cmj test/float_record.cmi test/float_record.cmj test/float_test.cmi test/float_test.cmj test/floatarray_test.cmi test/floatarray_test.cmj test/flow_parser_reg_test.cmi test/flow_parser_reg_test.cmj test/for_loop_test.cmi test/for_loop_test.cmj test/for_side_effect_test.cmi test/for_side_effect_test.cmj test/format_regression.cmi test/format_regression.cmj test/format_test.cmi test/format_test.cmj test/fs_test.cmi test/fs_test.cmj test/fun_pattern_match.cmi test/fun_pattern_match.cmj test/functor_app_test.cmi test/functor_app_test.cmj test/functor_def.cmi test/functor_def.cmj test/functor_ffi.cmi test/functor_ffi.cmj test/functor_inst.cmi test/functor_inst.cmj test/functors.cmi test/functors.cmj test/gbk.cmi test/gbk.cmj test/genlex_test.cmi test/genlex_test.cmj test/gentTypeReTest.cmi test/gentTypeReTest.cmj test/global_exception_regression_test.cmi test/global_exception_regression_test.cmj test/global_mangles.cmi test/global_mangles.cmj test/global_module_alias_test.cmi test/global_module_alias_test.cmj test/google_closure_test.cmi test/google_closure_test.cmj test/gpr496_test.cmi test/gpr496_test.cmj test/gpr_1072.cmi test/gpr_1072.cmj test/gpr_1072_reg.cmi test/gpr_1072_reg.cmj test/gpr_1150.cmi test/gpr_1150.cmj test/gpr_1154_test.cmi test/gpr_1154_test.cmj test/gpr_1170.cmi test/gpr_1170.cmj test/gpr_1240_missing_unbox.cmi test/gpr_1240_missing_unbox.cmj test/gpr_1245_test.cmi test/gpr_1245_test.cmj test/gpr_1268.cmi test/gpr_1268.cmj test/gpr_1409_test.cmi test/gpr_1409_test.cmj test/gpr_1423_app_test.cmi test/gpr_1423_app_test.cmj test/gpr_1423_nav.cmi test/gpr_1423_nav.cmj test/gpr_1438.cmi test/gpr_1438.cmj test/gpr_1481.cmi test/gpr_1481.cmj test/gpr_1484.cmi test/gpr_1484.cmj test/gpr_1503_test.cmi test/gpr_1503_test.cmj test/gpr_1539_test.cmi test/gpr_1539_test.cmj test/gpr_1658_test.cmi test/gpr_1658_test.cmj test/gpr_1667_test.cmi test/gpr_1667_test.cmj test/gpr_1692_test.cmi test/gpr_1692_test.cmj test/gpr_1698_test.cmi test/gpr_1698_test.cmj test/gpr_1701_test.cmi test/gpr_1701_test.cmj test/gpr_1716_test.cmi test/gpr_1716_test.cmj test/gpr_1717_test.cmi test/gpr_1717_test.cmj test/gpr_1728_test.cmi test/gpr_1728_test.cmj test/gpr_1749_test.cmi test/gpr_1749_test.cmj test/gpr_1759_test.cmi test/gpr_1759_test.cmj test/gpr_1760_test.cmi test/gpr_1760_test.cmj test/gpr_1762_test.cmi test/gpr_1762_test.cmj test/gpr_1817_test.cmi test/gpr_1817_test.cmj test/gpr_1822_test.cmi test/gpr_1822_test.cmj test/gpr_1891_test.cmi test/gpr_1891_test.cmj test/gpr_1943_test.cmi test/gpr_1943_test.cmj test/gpr_1946_test.cmi test/gpr_1946_test.cmj test/gpr_2316_test.cmi test/gpr_2316_test.cmj test/gpr_2352_test.cmi test/gpr_2352_test.cmj test/gpr_2413_test.cmi test/gpr_2413_test.cmj test/gpr_2474.cmi test/gpr_2474.cmj test/gpr_2487.cmi test/gpr_2487.cmj test/gpr_2503_test.cmi test/gpr_2503_test.cmj test/gpr_2608_test.cmi test/gpr_2608_test.cmj test/gpr_2614_test.cmi test/gpr_2614_test.cmj test/gpr_2633_test.cmi test/gpr_2633_test.cmj test/gpr_2642_test.cmi test/gpr_2642_test.cmj test/gpr_2652_test.cmi test/gpr_2652_test.cmj test/gpr_2682_test.cmi test/gpr_2682_test.cmj test/gpr_2700_test.cmi test/gpr_2700_test.cmj test/gpr_2731_test.cmi test/gpr_2731_test.cmj test/gpr_2789_test.cmi test/gpr_2789_test.cmj test/gpr_2931_test.cmi test/gpr_2931_test.cmj test/gpr_3142_test.cmi test/gpr_3142_test.cmj test/gpr_3154_test.cmi test/gpr_3154_test.cmj test/gpr_3209_test.cmi test/gpr_3209_test.cmj test/gpr_3492_test.cmi test/gpr_3492_test.cmj test/gpr_3519_jsx_test.cmi test/gpr_3519_jsx_test.cmj test/gpr_3519_test.cmi test/gpr_3519_test.cmj test/gpr_3536_test.cmi test/gpr_3536_test.cmj test/gpr_3546_test.cmi test/gpr_3546_test.cmj test/gpr_3548_test.cmi test/gpr_3548_test.cmj test/gpr_3549_test.cmi test/gpr_3549_test.cmj test/gpr_3566_drive_test.cmi test/gpr_3566_drive_test.cmj test/gpr_3566_test.cmi test/gpr_3566_test.cmj test/gpr_3595_test.cmi test/gpr_3595_test.cmj test/gpr_3609_test.cmi test/gpr_3609_test.cmj test/gpr_3697_test.cmi test/gpr_3697_test.cmj test/gpr_373_test.cmi test/gpr_373_test.cmj test/gpr_3770_test.cmi test/gpr_3770_test.cmj test/gpr_3852_alias.cmi test/gpr_3852_alias.cmj test/gpr_3852_alias_reify.cmi test/gpr_3852_alias_reify.cmj test/gpr_3852_effect.cmi test/gpr_3852_effect.cmj test/gpr_3865.cmi test/gpr_3865.cmj test/gpr_3865_bar.cmi test/gpr_3865_bar.cmj test/gpr_3865_foo.cmi test/gpr_3865_foo.cmj test/gpr_3875_test.cmi test/gpr_3875_test.cmj test/gpr_3877_test.cmi test/gpr_3877_test.cmj test/gpr_3895_test.cmi test/gpr_3895_test.cmj test/gpr_3897_test.cmi test/gpr_3897_test.cmj test/gpr_3931_test.cmi test/gpr_3931_test.cmj test/gpr_3980_test.cmi test/gpr_3980_test.cmj test/gpr_4025_test.cmi test/gpr_4025_test.cmj test/gpr_405_test.cmi test/gpr_405_test.cmj test/gpr_4069_test.cmi test/gpr_4069_test.cmj test/gpr_4265_test.cmi test/gpr_4265_test.cmj test/gpr_4274_test.cmi test/gpr_4274_test.cmj test/gpr_4280_test.cmi test/gpr_4280_test.cmj test/gpr_4407_test.cmi test/gpr_4407_test.cmj test/gpr_441.cmi test/gpr_441.cmj test/gpr_4442_test.cmi test/gpr_4442_test.cmj test/gpr_4491_test.cmi test/gpr_4491_test.cmj test/gpr_4494_test.cmi test/gpr_4494_test.cmj test/gpr_4519_test.cmi test/gpr_4519_test.cmj test/gpr_459_test.cmi test/gpr_459_test.cmj test/gpr_4632.cmi test/gpr_4632.cmj test/gpr_4639_test.cmi test/gpr_4639_test.cmj test/gpr_4900_test.cmi test/gpr_4900_test.cmj test/gpr_4924_test.cmi test/gpr_4924_test.cmj test/gpr_4931.cmi test/gpr_4931.cmj test/gpr_4931_allow.cmi test/gpr_4931_allow.cmj test/gpr_5071_test.cmi test/gpr_5071_test.cmj test/gpr_5169_test.cmi test/gpr_5169_test.cmj test/gpr_5218_test.cmi test/gpr_5218_test.cmj test/gpr_5280_optimize_test.cmi test/gpr_5280_optimize_test.cmj test/gpr_5312.cmi test/gpr_5312.cmj test/gpr_5557.cmi test/gpr_5557.cmj test/gpr_5753.cmi test/gpr_5753.cmj test/gpr_658.cmi test/gpr_658.cmj test/gpr_858_test.cmi test/gpr_858_test.cmj test/gpr_858_unit2_test.cmi test/gpr_858_unit2_test.cmj test/gpr_904_test.cmi test/gpr_904_test.cmj test/gpr_974_test.cmi test/gpr_974_test.cmj test/gpr_977_test.cmi test/gpr_977_test.cmj test/gpr_return_type_unused_attribute.cmi test/gpr_return_type_unused_attribute.cmj test/gray_code_test.cmi test/gray_code_test.cmj test/guide_for_ext.cmi test/guide_for_ext.cmj test/hamming_test.cmi test/hamming_test.cmj test/hash_collision_test.cmi test/hash_collision_test.cmj test/hash_sugar_desugar.cmi test/hash_sugar_desugar.cmj test/hash_test.cmi test/hash_test.cmj test/hashtbl_test.cmi test/hashtbl_test.cmj test/hello.foo.cmi test/hello.foo.cmj test/hello_res.cmi test/hello_res.cmj test/ignore_test.cmi test/ignore_test.cmj test/imm_map_bench.cmi test/imm_map_bench.cmj test/include_side_effect.cmi test/include_side_effect.cmj test/include_side_effect_free.cmi test/include_side_effect_free.cmj test/incomplete_toplevel_test.cmi test/incomplete_toplevel_test.cmj test/infer_type_test.cmi test/infer_type_test.cmj test/inline_const.cmi test/inline_const.cmj test/inline_const_test.cmi test/inline_const_test.cmj test/inline_edge_cases.cmi test/inline_edge_cases.cmj test/inline_map2_test.cmi test/inline_map2_test.cmj test/inline_map_demo.cmi test/inline_map_demo.cmj test/inline_map_test.cmi test/inline_map_test.cmj test/inline_record_test.cmi test/inline_record_test.cmj test/inline_regression_test.cmi test/inline_regression_test.cmj test/inline_string_test.cmi test/inline_string_test.cmj test/inner_call.cmi test/inner_call.cmj test/inner_define.cmi test/inner_define.cmj test/inner_unused.cmi test/inner_unused.cmj test/installation_test.cmi test/installation_test.cmj test/int32_test.cmi test/int32_test.cmj test/int64_mul_div_test.cmi test/int64_mul_div_test.cmj test/int64_string_bench.cmi test/int64_string_bench.cmj test/int64_string_test.cmi test/int64_string_test.cmj test/int64_test.cmi test/int64_test.cmj test/int_hashtbl_test.cmi test/int_hashtbl_test.cmj test/int_map.cmi test/int_map.cmj test/int_overflow_test.cmi test/int_overflow_test.cmj test/int_poly_var.cmi test/int_poly_var.cmj test/int_switch_test.cmi test/int_switch_test.cmj test/internal_unused_test.cmi test/internal_unused_test.cmj test/io_test.cmi test/io_test.cmj test/js_array_test.cmi test/js_array_test.cmj test/js_bool_test.cmi test/js_bool_test.cmj test/js_cast_test.cmi test/js_cast_test.cmj test/js_date_test.cmi test/js_date_test.cmj test/js_dict_test.cmi test/js_dict_test.cmj test/js_exception_catch_test.cmi test/js_exception_catch_test.cmj test/js_float_test.cmi test/js_float_test.cmj test/js_global_test.cmi test/js_global_test.cmj test/js_int_test.cmi test/js_int_test.cmj test/js_json_test.cmi test/js_json_test.cmj test/js_list_test.cmi test/js_list_test.cmj test/js_math_test.cmi test/js_math_test.cmj test/js_null_test.cmi test/js_null_test.cmj test/js_null_undefined_test.cmi test/js_null_undefined_test.cmj test/js_nullable_test.cmi test/js_nullable_test.cmj test/js_obj_test.cmi test/js_obj_test.cmj test/js_option_test.cmi test/js_option_test.cmj test/js_promise_basic_test.cmi test/js_promise_basic_test.cmj test/js_re_test.cmi test/js_re_test.cmj test/js_string_test.cmi test/js_string_test.cmj test/js_typed_array_test.cmi test/js_typed_array_test.cmj test/js_undefined_test.cmi test/js_undefined_test.cmj test/js_val.cmi test/js_val.cmj test/jsoo_400_test.cmi test/jsoo_400_test.cmj test/jsoo_485_test.cmi test/jsoo_485_test.cmj test/jsxv4_newtype.cmi test/jsxv4_newtype.cmj test/key_word_property.cmi test/key_word_property.cmj test/key_word_property2.cmi test/key_word_property2.cmj test/key_word_property_plus_test.cmi test/key_word_property_plus_test.cmj test/label_uncurry.cmi test/label_uncurry.cmj test/large_integer_pat.cmi test/large_integer_pat.cmj test/large_record_duplication_test.cmi test/large_record_duplication_test.cmj test/largest_int_flow.cmi test/largest_int_flow.cmj test/lazy_demo.cmi test/lazy_demo.cmj test/lazy_test.cmi test/lazy_test.cmj test/lib_js_test.cmi test/lib_js_test.cmj test/libarg_test.cmi test/libarg_test.cmj test/libqueue_test.cmi test/libqueue_test.cmj test/limits_test.cmi test/limits_test.cmj test/list_stack.cmi test/list_stack.cmj test/list_test.cmi test/list_test.cmj test/local_exception_test.cmi test/local_exception_test.cmj test/loop_regression_test.cmi test/loop_regression_test.cmj test/loop_suites_test.cmi test/loop_suites_test.cmj test/map_find_test.cmi test/map_find_test.cmj test/map_test.cmi test/map_test.cmj test/mario_game.cmi test/mario_game.cmj test/marshal.cmi test/marshal.cmj test/meth_annotation.cmi test/meth_annotation.cmj test/method_name_test.cmi test/method_name_test.cmj test/method_string_name.cmi test/method_string_name.cmj test/minimal_test.cmi test/minimal_test.cmj test/miss_colon_test.cmi test/miss_colon_test.cmj test/mock_mt.cmi test/mock_mt.cmj test/module_alias_test.cmi test/module_alias_test.cmj test/module_as_class_ffi.cmi test/module_as_class_ffi.cmj test/module_as_function.cmi test/module_as_function.cmj test/module_missing_conversion.cmi test/module_missing_conversion.cmj test/module_parameter_test.cmi test/module_parameter_test.cmj test/module_splice_test.cmi test/module_splice_test.cmj test/more_poly_variant_test.cmi test/more_poly_variant_test.cmj test/more_uncurry.cmi test/more_uncurry.cmj test/mpr_6033_test.cmi test/mpr_6033_test.cmj test/mt.cmi test/mt.cmj test/mt_global.cmi test/mt_global.cmj test/mutable_obj_test.cmi test/mutable_obj_test.cmj test/mutable_uncurry_test.cmi test/mutable_uncurry_test.cmj test/mutual_non_recursive_type.cmi test/mutual_non_recursive_type.cmj test/name_mangle_test.cmi test/name_mangle_test.cmj test/nested_include.cmi test/nested_include.cmj test/nested_module_alias.cmi test/nested_module_alias.cmj test/nested_obj_literal.cmi test/nested_obj_literal.cmj test/nested_obj_test.cmi test/nested_obj_test.cmj test/nested_pattern_match_test.cmi test/nested_pattern_match_test.cmj test/noassert.cmi test/noassert.cmj test/node_fs_test.cmi test/node_fs_test.cmj test/node_path_test.cmi test/node_path_test.cmj test/null_list_test.cmi test/null_list_test.cmj test/number_lexer.cmi test/number_lexer.cmj test/obj_literal_ppx.cmi test/obj_literal_ppx.cmj test/obj_literal_ppx_test.cmi test/obj_literal_ppx_test.cmj test/obj_magic_test.cmi test/obj_magic_test.cmj test/obj_type_test.cmi test/obj_type_test.cmj test/ocaml_re_test.cmi test/ocaml_re_test.cmj test/of_string_test.cmi test/of_string_test.cmj test/offset.cmi test/offset.cmj test/option_encoding_test.cmi test/option_encoding_test.cmj test/option_record_none_test.cmi test/option_record_none_test.cmj test/option_repr_test.cmi test/option_repr_test.cmj test/optional_ffi_test.cmi test/optional_ffi_test.cmj test/optional_regression_test.cmi test/optional_regression_test.cmj test/pipe_send_readline.cmi test/pipe_send_readline.cmj test/pipe_syntax.cmi test/pipe_syntax.cmj test/poly_empty_array.cmi test/poly_empty_array.cmj test/poly_variant_test.cmi test/poly_variant_test.cmj test/polymorphic_raw_test.cmi test/polymorphic_raw_test.cmj test/polymorphism_test.cmi test/polymorphism_test.cmj test/polyvar_convert.cmi test/polyvar_convert.cmj test/polyvar_test.cmi test/polyvar_test.cmj test/ppx_apply_test.cmi test/ppx_apply_test.cmj test/pq_test.cmi test/pq_test.cmj test/pr6726.cmi test/pr6726.cmj test/pr_regression_test.cmi test/pr_regression_test.cmj test/prepend_data_ffi.cmi test/prepend_data_ffi.cmj test/primitive_reg_test.cmi test/primitive_reg_test.cmj test/print_alpha_test.cmi test/print_alpha_test.cmj test/promise_catch_test.cmi test/promise_catch_test.cmj test/queue_402.cmi test/queue_402.cmj test/queue_test.cmi test/queue_test.cmj test/random_test.cmi test/random_test.cmj test/raw_hash_tbl_bench.cmi test/raw_hash_tbl_bench.cmj test/raw_output_test.cmi test/raw_output_test.cmj test/raw_pure_test.cmi test/raw_pure_test.cmj test/rbset.cmi test/rbset.cmj test/react.cmi test/react.cmj test/reactDOMRe.cmi test/reactDOMRe.cmj test/reactDOMServerRe.cmi test/reactDOMServerRe.cmj test/reactEvent.cmi test/reactEvent.cmj test/reactTestUtils.cmi test/reactTestUtils.cmj test/reasonReact.cmi test/reasonReact.cmj test/reasonReactCompat.cmi test/reasonReactCompat.cmj test/reasonReactOptimizedCreateClass.cmi test/reasonReactOptimizedCreateClass.cmj test/reasonReactRouter.cmi test/reasonReactRouter.cmj test/rebind_module.cmi test/rebind_module.cmj test/rebind_module_test.cmi test/rebind_module_test.cmj test/rec_array_test.cmi test/rec_array_test.cmj test/rec_fun_test.cmi test/rec_fun_test.cmj test/rec_module_opt.cmi test/rec_module_opt.cmj test/rec_module_test.cmi test/rec_module_test.cmj test/rec_value_test.cmi test/rec_value_test.cmj test/record_debug_test.cmi test/record_debug_test.cmj test/record_extension_test.cmi test/record_extension_test.cmj test/record_name_test.cmi test/record_name_test.cmj test/record_regression.cmi test/record_regression.cmj test/record_with_test.cmi test/record_with_test.cmj test/recursive_module.cmi test/recursive_module.cmj test/recursive_module_test.cmi test/recursive_module_test.cmj test/recursive_react_component.cmi test/recursive_react_component.cmj test/recursive_records_test.cmi test/recursive_records_test.cmj test/recursive_unbound_module_test.cmi test/recursive_unbound_module_test.cmj test/regression_print.cmi test/regression_print.cmj test/relative_path.cmi test/relative_path.cmj test/res_debug.cmi test/res_debug.cmj test/return_check.cmi test/return_check.cmj test/runtime_encoding_test.cmi test/runtime_encoding_test.cmj test/set_annotation.cmi test/set_annotation.cmj test/set_gen.cmi test/set_gen.cmj test/sexp.cmi test/sexp.cmj test/sexpm.cmi test/sexpm.cmj test/sexpm_test.cmi test/sexpm_test.cmj test/side_effect.cmi test/side_effect.cmj test/side_effect_free.cmi test/side_effect_free.cmj test/simple_derive_test.cmi test/simple_derive_test.cmj test/simple_derive_use.cmi test/simple_derive_use.cmj test/simple_lexer_test.cmi test/simple_lexer_test.cmj test/simplify_lambda_632o.cmi test/simplify_lambda_632o.cmj test/single_module_alias.cmi test/single_module_alias.cmj test/singular_unit_test.cmi test/singular_unit_test.cmj test/small_inline_test.cmi test/small_inline_test.cmj test/splice_test.cmi test/splice_test.cmj test/stack_comp_test.cmi test/stack_comp_test.cmj test/stack_test.cmi test/stack_test.cmj test/stream_parser_test.cmi test/stream_parser_test.cmj test/string_bound_get_test.cmi test/string_bound_get_test.cmj test/string_constant_compare.cmi test/string_constant_compare.cmj test/string_get_set_test.cmi test/string_get_set_test.cmj test/string_literal_print_test.cmi test/string_literal_print_test.cmj test/string_runtime_test.cmi test/string_runtime_test.cmj test/string_set.cmi test/string_set.cmj test/string_set_test.cmi test/string_set_test.cmj test/string_test.cmi test/string_test.cmj test/string_unicode_test.cmi test/string_unicode_test.cmj test/stringmatch_test.cmi test/stringmatch_test.cmj test/submodule.cmi test/submodule.cmj test/submodule_call.cmi test/submodule_call.cmj test/switch_case_test.cmi test/switch_case_test.cmj test/switch_string.cmi test/switch_string.cmj test/tailcall_inline_test.cmi test/tailcall_inline_test.cmj test/template.cmi test/template.cmj test/test.cmi test/test.cmj test/test2.cmi test/test2.cmj test/test_alias.cmi test/test_alias.cmj test/test_ari.cmi test/test_ari.cmj test/test_array.cmi test/test_array.cmj test/test_array_append.cmi test/test_array_append.cmj test/test_array_primitive.cmi test/test_array_primitive.cmj test/test_bool_equal.cmi test/test_bool_equal.cmj test/test_bs_this.cmi test/test_bs_this.cmj test/test_bug.cmi test/test_bug.cmj test/test_bytes.cmi test/test_bytes.cmj test/test_case_opt_collision.cmi test/test_case_opt_collision.cmj test/test_case_set.cmi test/test_case_set.cmj test/test_char.cmi test/test_char.cmj test/test_closure.cmi test/test_closure.cmj test/test_common.cmi test/test_common.cmj test/test_const_elim.cmi test/test_const_elim.cmj test/test_const_propogate.cmi test/test_const_propogate.cmj test/test_cpp.cmi test/test_cpp.cmj test/test_cps.cmi test/test_cps.cmj test/test_demo.cmi test/test_demo.cmj test/test_dup_param.cmi test/test_dup_param.cmj test/test_eq.cmi test/test_eq.cmj test/test_exception.cmi test/test_exception.cmj test/test_exception_escape.cmi test/test_exception_escape.cmj test/test_export2.cmi test/test_export2.cmj test/test_external.cmi test/test_external.cmj test/test_external_unit.cmi test/test_external_unit.cmj test/test_ffi.cmi test/test_ffi.cmj test/test_fib.cmi test/test_fib.cmj test/test_filename.cmi test/test_filename.cmj test/test_for_loop.cmi test/test_for_loop.cmj test/test_for_map.cmi test/test_for_map.cmj test/test_for_map2.cmi test/test_for_map2.cmj test/test_format.cmi test/test_format.cmj test/test_formatter.cmi test/test_formatter.cmj test/test_functor_dead_code.cmi test/test_functor_dead_code.cmj test/test_generative_module.cmi test/test_generative_module.cmj test/test_global_print.cmi test/test_global_print.cmj test/test_google_closure.cmi test/test_google_closure.cmj test/test_include.cmi test/test_include.cmj test/test_incomplete.cmi test/test_incomplete.cmj test/test_incr_ref.cmi test/test_incr_ref.cmj test/test_int_map_find.cmi test/test_int_map_find.cmj test/test_internalOO.cmi test/test_internalOO.cmj test/test_is_js.cmi test/test_is_js.cmj test/test_js_ffi.cmi test/test_js_ffi.cmj test/test_let.cmi test/test_let.cmj test/test_list.cmi test/test_list.cmj test/test_literal.cmi test/test_literal.cmj test/test_literals.cmi test/test_literals.cmj test/test_match_exception.cmi test/test_match_exception.cmj test/test_mutliple.cmi test/test_mutliple.cmj test/test_nat64.cmi test/test_nat64.cmj test/test_nested_let.cmi test/test_nested_let.cmj test/test_nested_print.cmi test/test_nested_print.cmj test/test_non_export.cmi test/test_non_export.cmj test/test_nullary.cmi test/test_nullary.cmj test/test_obj.cmi test/test_obj.cmj test/test_obj_simple_ffi.cmi test/test_obj_simple_ffi.cmj test/test_order.cmi test/test_order.cmj test/test_order_tailcall.cmi test/test_order_tailcall.cmj test/test_other_exn.cmi test/test_other_exn.cmj test/test_pack.cmi test/test_pack.cmj test/test_per.cmi test/test_per.cmj test/test_pervasive.cmi test/test_pervasive.cmj test/test_pervasives2.cmi test/test_pervasives2.cmj test/test_pervasives3.cmi test/test_pervasives3.cmj test/test_primitive.cmi test/test_primitive.cmj test/test_ramification.cmi test/test_ramification.cmj test/test_react.cmi test/test_react.cmj test/test_react_case.cmi test/test_react_case.cmj test/test_regex.cmi test/test_regex.cmj test/test_require.cmi test/test_require.cmj test/test_runtime_encoding.cmi test/test_runtime_encoding.cmj test/test_scope.cmi test/test_scope.cmj test/test_seq.cmi test/test_seq.cmj test/test_set.cmi test/test_set.cmj test/test_side_effect_functor.cmi test/test_side_effect_functor.cmj test/test_simple_include.cmi test/test_simple_include.cmj test/test_simple_pattern_match.cmi test/test_simple_pattern_match.cmj test/test_simple_ref.cmi test/test_simple_ref.cmj test/test_simple_tailcall.cmi test/test_simple_tailcall.cmj test/test_small.cmi test/test_small.cmj test/test_sprintf.cmi test/test_sprintf.cmj test/test_stack.cmi test/test_stack.cmj test/test_static_catch_ident.cmi test/test_static_catch_ident.cmj test/test_string.cmi test/test_string.cmj test/test_string_case.cmi test/test_string_case.cmj test/test_string_const.cmi test/test_string_const.cmj test/test_string_map.cmi test/test_string_map.cmj test/test_string_switch.cmi test/test_string_switch.cmj test/test_switch.cmi test/test_switch.cmj test/test_trywith.cmi test/test_trywith.cmj test/test_tuple.cmi test/test_tuple.cmj test/test_tuple_destructring.cmi test/test_tuple_destructring.cmj test/test_type_based_arity.cmi test/test_type_based_arity.cmj test/test_u.cmi test/test_u.cmj test/test_unknown.cmi test/test_unknown.cmj test/test_unsafe_cmp.cmi test/test_unsafe_cmp.cmj test/test_unsafe_obj_ffi.cmi test/test_unsafe_obj_ffi.cmj test/test_unsafe_obj_ffi_ppx.cmi test/test_unsafe_obj_ffi_ppx.cmj test/test_unsupported_primitive.cmi test/test_unsupported_primitive.cmj test/test_while_closure.cmi test/test_while_closure.cmj test/test_while_side_effect.cmi test/test_while_side_effect.cmj test/test_zero_nullable.cmi test/test_zero_nullable.cmj test/then_mangle_test.cmi test/then_mangle_test.cmj test/ticker.cmi test/ticker.cmj test/to_string_test.cmi test/to_string_test.cmj test/topsort_test.cmi test/topsort_test.cmj test/tramp_fib.cmi test/tramp_fib.cmj test/tuple_alloc.cmi test/tuple_alloc.cmj test/type_disambiguate.cmi test/type_disambiguate.cmj test/typeof_test.cmi test/typeof_test.cmj test/ui_defs.cmi test/unboxed_attribute.cmi test/unboxed_attribute.cmj test/unboxed_attribute_test.cmi test/unboxed_attribute_test.cmj test/unboxed_crash.cmi test/unboxed_crash.cmj test/unboxed_use_case.cmi test/unboxed_use_case.cmj test/uncurried_cast.cmi test/uncurried_cast.cmj test/uncurried_default.args.cmi test/uncurried_default.args.cmj test/uncurried_pipe.cmi test/uncurried_pipe.cmj test/uncurry_external_test.cmi test/uncurry_external_test.cmj test/uncurry_glob_test.cmi test/uncurry_glob_test.cmj test/uncurry_test.cmi test/uncurry_test.cmj test/undef_regression2_test.cmi test/undef_regression2_test.cmj test/undef_regression_test.cmi test/undef_regression_test.cmj test/undefine_conditional.cmi test/undefine_conditional.cmj test/unicode_type_error.cmi test/unicode_type_error.cmj test/unit_undefined_test.cmi test/unit_undefined_test.cmj test/unitest_string.cmi test/unitest_string.cmj test/unsafe_full_apply_primitive.cmi test/unsafe_full_apply_primitive.cmj test/unsafe_ppx_test.cmi test/unsafe_ppx_test.cmj test/unsafe_this.cmi test/unsafe_this.cmj test/update_record_test.cmi test/update_record_test.cmj test/utf8_decode_test.cmi test/utf8_decode_test.cmj test/variant.cmi test/variant.cmj test/variantsMatching.cmi test/variantsMatching.cmj test/watch_test.cmi test/watch_test.cmj test/webpack_config.cmi test/webpack_config.cmj From e5e0522277b06e8d648ba01f2078604a7f9462db Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Thu, 30 Mar 2023 18:17:01 +0200 Subject: [PATCH 02/31] First few examples working. --- jscomp/core/js_dump.ml | 21 +++++---- jscomp/core/js_exp_make.ml | 14 ++++++ jscomp/core/js_exp_make.mli | 2 + jscomp/core/js_stmt_make.ml | 4 +- jscomp/core/lam_compile.ml | 73 +++++++++++++++++++++++------- jscomp/core/matching_polyfill.ml | 9 +++- jscomp/frontend/ast_attributes.ml | 9 ++++ jscomp/frontend/ast_attributes.mli | 1 + jscomp/ml/lambda.ml | 11 ++++- jscomp/ml/lambda.mli | 10 +++- jscomp/ml/matching.ml | 1 + jscomp/ml/typedecl.ml | 13 ++++-- jscomp/test/UntaggedVariants.js | 72 +++++++++++++++++++++++++---- jscomp/test/UntaggedVariants.res | 38 +++++++++++++++- 14 files changed, 231 insertions(+), 47 deletions(-) diff --git a/jscomp/core/js_dump.ml b/jscomp/core/js_dump.ml index 2a84bfe921..2957abf50c 100644 --- a/jscomp/core/js_dump.ml +++ b/jscomp/core/js_dump.ml @@ -751,6 +751,7 @@ and expression_desc cxt ~(level : int) f x : cxt = | Caml_block (el, _, _, ((Blk_extension | Blk_record_ext _) as ext)) -> expression_desc cxt ~level f (exn_block_as_obj ~stack:false el ext) | Caml_block (el, _, tag, Blk_record_inlined p) -> + let untagged = Ast_attributes.process_untagged p.attrs in let objs = let tails = Ext_list.combine_array_append p.fields el @@ -774,16 +775,20 @@ and expression_desc cxt ~(level : int) f x : cxt = | Undefined when is_optional f -> None | _ -> Some (f, x)) in - ( Js_op.Lit tag_name, (* TAG:xx for inline records *) - match Ast_attributes.process_as_value p.attrs with - | None -> E.str p.name - | Some as_value -> E.as_value as_value ) - :: tails + if untagged then + tails + else + (Js_op.Lit tag_name, (* TAG:xx for inline records *) + match Ast_attributes.process_as_value p.attrs with + | None -> E.str p.name + | Some as_value -> E.as_value as_value ) + :: tails in expression_desc cxt ~level f (Object objs) | Caml_block (el, _, tag, Blk_constructor p) -> let not_is_cons = p.name <> Literals.cons in let as_value = Ast_attributes.process_as_value p.attrs in + let untagged = Ast_attributes.process_untagged p.attrs in let tag_name = match Ast_attributes.process_tag_name p.attrs with | None -> L.tag | Some s -> s in @@ -800,7 +805,7 @@ and expression_desc cxt ~(level : int) f x : cxt = [ (name_symbol, E.str p.name) ] else []) in - if (as_value = Some AsUnboxed || not_is_cons = false) && p.num_nonconst = 1 then tails + if untagged || (as_value = Some AsUnboxed || not_is_cons = false) && p.num_nonconst = 1 then tails else ( Js_op.Lit tag_name, (* TAG:xx *) match as_value with @@ -809,8 +814,8 @@ and expression_desc cxt ~(level : int) f x : cxt = :: tails in let exp = match objs with - | [(_, e)] when as_value = Some AsUnboxed -> e.expression_desc - | _ when as_value = Some AsUnboxed -> assert false (* should not happen *) + | [(_, e)] when untagged || as_value = Some AsUnboxed -> e.expression_desc + | _ when untagged || as_value = Some AsUnboxed -> assert false (* should not happen *) (* TODO: put restriction on the variant definitions allowed, to make sure this never happens. *) | _ -> J.Object objs in expression_desc cxt ~level f exp diff --git a/jscomp/core/js_exp_make.ml b/jscomp/core/js_exp_make.ml index e71db5c86a..593c0e50f7 100644 --- a/jscomp/core/js_exp_make.ml +++ b/jscomp/core/js_exp_make.ml @@ -335,6 +335,8 @@ let as_value = function | AsBool b -> bool b | AsNull -> nil | AsUndefined -> undefined + | AsUntagged IntType -> str "number" + | AsUntagged StringType -> str "string" | AsUnboxed -> assert false (* Should not emit tags for unboxed *) (* TODO: put restriction on the variant definitions allowed, to make sure this never happens. *) @@ -762,6 +764,18 @@ let string_equal ?comment (e0 : t) (e1 : t) : t = let is_type_number ?comment (e : t) : t = string_equal ?comment (typeof e) (str "number") +let rec is_not_untagged ~untagged_cases (e:t) : t = + let is_case (c:Lambda.untagged) : t = match c with + | Unothing -> assert false + | Ustring -> { expression_desc = Bin (NotEqEq, typeof e, str "string"); comment=None } + | Uint -> { expression_desc = Bin (NotEqEq, typeof e, str "number"); comment=None } + in + match untagged_cases with + | [c] -> is_case c + | c1 :: (_::_ as rest) -> + { J.expression_desc = Bin (And, is_case c1, is_not_untagged ~untagged_cases:rest e ); comment = None } + | [] -> assert false + let is_tag ?(has_null_undefined_other=(false, false, false)) (e : t) : t = let (has_null, has_undefined, has_other) = has_null_undefined_other in if has_null && (has_undefined = false) && (has_other = false) then (* null *) diff --git a/jscomp/core/js_exp_make.mli b/jscomp/core/js_exp_make.mli index 565b03d27b..e4b2e53579 100644 --- a/jscomp/core/js_exp_make.mli +++ b/jscomp/core/js_exp_make.mli @@ -204,6 +204,8 @@ val is_type_number : ?comment:string -> t -> t val is_tag : ?has_null_undefined_other:(bool * bool * bool) -> t -> t +val is_not_untagged : untagged_cases:Lambda.untagged list -> t -> t + val is_type_string : ?comment:string -> t -> t val is_type_object : t -> t diff --git a/jscomp/core/js_stmt_make.ml b/jscomp/core/js_stmt_make.ml index 4ce4a8ddab..f487a32dac 100644 --- a/jscomp/core/js_stmt_make.ml +++ b/jscomp/core/js_stmt_make.ml @@ -138,7 +138,9 @@ let string_switch ?(comment : string option) match switch_case with | AsString s -> if s = txt then Some x.switch_body else None - | AsInt _ | AsFloat _| AsBool _ | AsNull | AsUnboxed | AsUndefined -> None) + | AsInt _ | AsFloat _| AsBool _ | AsNull | AsUnboxed + | AsUndefined + | AsUntagged _ -> None) with | Some case -> case | None -> ( match default with Some x -> x | None -> assert false) diff --git a/jscomp/core/lam_compile.ml b/jscomp/core/lam_compile.ml index 189bd1559b..bf69e24b12 100644 --- a/jscomp/core/lam_compile.ml +++ b/jscomp/core/lam_compile.ml @@ -153,15 +153,27 @@ let get_tag_name (sw_names : Lambda.switch_names option) = | _ -> Js_dump_lit.tag ) +let get_untagged_cases (sw_names : Lambda.switch_names option) = + let res = ref [] in + (match sw_names with + | None -> res := [] + | Some { blocks } -> + Array.iter (fun {Lambda.cstr_untagged} -> + if cstr_untagged <> Unothing + then res := cstr_untagged :: !res) blocks + ); + !res + let has_null_undefined_other (sw_names : Lambda.switch_names option) = let (null, undefined, other) = (ref false, ref false, ref false) in (match sw_names with | None -> () - | Some { consts } -> + | Some { consts; blocks } -> Ext_array.iter consts (fun x -> match x.as_value with | Some AsUndefined -> undefined := true | Some AsNull -> null := true - | _ -> other := true)); + | _ -> other := true); + ); (!null, !undefined, !other) let no_effects_const = lazy true @@ -476,7 +488,7 @@ and compile_general_cases : 'a . ('a -> Lambda.cstr_name option) -> ('a -> J.expression) -> - (J.expression -> J.expression -> J.expression) -> + ('a option -> J.expression -> 'a option -> J.expression -> J.expression) -> Lam_compile_context.t -> (?default:J.block -> ?declaration:Lam_compat.let_kind * Ident.t -> @@ -488,7 +500,7 @@ and compile_general_cases : default_case -> J.block = fun (get_cstr_name : _ -> Lambda.cstr_name option) (make_exp : _ -> J.expression) - (eq_exp : J.expression -> J.expression -> J.expression) + (eq_exp : 'a option -> J.expression -> 'a option -> J.expression -> J.expression) (cxt : Lam_compile_context.t) (switch : ?default:J.block -> @@ -512,7 +524,7 @@ and compile_general_cases : morph_declare_to_assign cxt (fun cxt define -> [ S.if_ ?declaration:define - (eq_exp switch_exp (make_exp id)) + (eq_exp None switch_exp (Some id) (make_exp id)) (Js_output.output_as_block (compile_lambda cxt lam)); ]) | [ (id, lam) ], Default x | [ (id, lam); (_, x) ], Complete -> @@ -521,7 +533,7 @@ and compile_general_cases : let then_block = Js_output.output_as_block (compile_lambda cxt lam) in [ S.if_ ?declaration:define - (eq_exp switch_exp (make_exp id)) + (eq_exp None switch_exp (Some id) (make_exp id)) then_block ~else_:else_block; ]) | _, _ -> @@ -590,23 +602,25 @@ and compile_general_cases : [ switch ?default ?declaration switch_exp body ]) -and all_cases_have_name table get_name = +and use_compile_string_cases table get_name = List.fold_right (fun (i, lam) acc -> match get_name i, acc with - | Some {Lambda.as_value= Some as_value}, Some string_table -> Some ((as_value, lam) :: string_table) + | Some {Lambda.as_value = Some as_value}, Some string_table -> + Some ((as_value, lam) :: string_table) | Some {name; as_value = None}, Some string_table -> Some ((AsString name, lam) :: string_table) | _, _ -> None ) table (Some []) and compile_cases cxt (switch_exp : E.t) table default get_name = - match all_cases_have_name table get_name with - | Some string_table -> compile_string_cases cxt switch_exp string_table default + match use_compile_string_cases table get_name with + | Some string_table -> + compile_string_cases cxt switch_exp string_table default | None -> compile_general_cases get_name (fun i -> match get_name i with | None -> E.small_int i | Some {as_value = Some(AsString s)} -> E.str s | Some {name} -> E.str name) - E.int_equal cxt + (fun _ x _ y -> E.int_equal x y) cxt (fun ?default ?declaration e clauses -> S.int_switch ?default ?declaration e clauses) switch_exp table default @@ -637,9 +651,15 @@ and compile_switch (switch_arg : Lam.t) (sw : Lam.lambda_switch) in let get_const_name i = get_const_name i sw_names in let get_block i = get_block i sw_names in + let untagged_cases = get_untagged_cases sw_names in let get_block_name i = match get_block i with | None -> None - | Some {cstr_name} -> Some cstr_name in + | Some ({cstr_untagged = Uint} as block) -> + Some {block.cstr_name with as_value = Some (AsUntagged IntType)} + | Some ({cstr_untagged = Ustring} as block) -> + Some {block.cstr_name with as_value = Some (AsUntagged StringType)} + | Some ({cstr_untagged = Unothing; cstr_name}) -> + Some cstr_name in let tag_name = get_tag_name sw_names in let compile_whole (cxt : Lam_compile_context.t) = match @@ -650,17 +670,22 @@ and compile_switch (switch_arg : Lam.t) (sw : Lam.lambda_switch) block @ if sw_consts_full && sw_consts = [] then - compile_cases cxt (E.tag ~name:tag_name e) sw_blocks sw_blocks_default get_block_name + compile_cases cxt (if untagged_cases <> [] then e else E.tag ~name:tag_name e) sw_blocks sw_blocks_default get_block_name else if sw_blocks_full && sw_blocks = [] then compile_cases cxt e sw_consts sw_num_default get_const_name else (* [e] will be used twice *) let dispatch e = - S.if_ (E.is_tag ~has_null_undefined_other:(has_null_undefined_other sw_names) e) + let is_tag = + if untagged_cases <> [] + then E.is_not_untagged ~untagged_cases:untagged_cases e + else + E.is_tag ~has_null_undefined_other:(has_null_undefined_other sw_names) e in + S.if_ is_tag (compile_cases cxt e sw_consts sw_num_default get_const_name) (* default still needed, could simplified*) ~else_: - (compile_cases cxt (E.tag ~name:tag_name e) sw_blocks sw_blocks_default + (compile_cases cxt (if untagged_cases <> [] then e else E.tag ~name:tag_name e) sw_blocks sw_blocks_default get_block_name) in match e.expression_desc with @@ -689,10 +714,24 @@ and compile_switch (switch_arg : Lam.t) (sw : Lam.lambda_switch) | EffectCall _ | Assign _ -> Js_output.make (compile_whole lambda_cxt) and compile_string_cases cxt switch_exp table default = + let value = function + | as_value -> E.as_value as_value + in + let add_runtime_type_check (as_value: Lambda.as_value) x = match as_value with + | AsUntagged IntType + | AsUntagged StringType -> E.typeof x + | AsBool _ | AsFloat _ | AsInt _ | AsString _ | AsNull | AsUnboxed | AsUndefined -> x in + let mk_eq (i : Lambda.as_value option) x j y = match i, j with + | Some as_value, _ -> + E.string_equal x (add_runtime_type_check as_value y) + | _, Some as_value -> + E.string_equal (add_runtime_type_check as_value x) y + | _ -> E.string_equal x y + in compile_general_cases (fun _ -> None) - E.as_value - E.string_equal cxt + value mk_eq + cxt (fun ?default ?declaration e clauses -> S.string_switch ?default ?declaration e clauses) switch_exp table default diff --git a/jscomp/core/matching_polyfill.ml b/jscomp/core/matching_polyfill.ml index 2b6cc9e6bb..2a35a6a12e 100644 --- a/jscomp/core/matching_polyfill.ml +++ b/jscomp/core/matching_polyfill.ml @@ -32,8 +32,15 @@ let names_from_construct_pattern (pat : Typedtree.pattern) = as_value = Ast_attributes.process_as_value cstr.cd_attributes } in let get_tag_name (cstr: Types.constructor_declaration) = Ast_attributes.process_tag_name cstr.cd_attributes in + let get_untagged (cstr: Types.constructor_declaration) = + match Ast_attributes.process_untagged cstr.cd_attributes, cstr.cd_args with + | false, _ -> Lambda.Unothing + | true, Cstr_tuple [{desc = Tconstr (path, _, _)}] when Path.same path Predef.path_string -> Ustring + | true, Cstr_tuple [{desc = Tconstr (path, _, _)}] when Path.same path Predef.path_int -> Uint + | true, _ -> Unothing + in let get_block cstr : Lambda.block = - {cstr_name = get_cstr_name cstr; tag_name = get_tag_name cstr} in + {cstr_name = get_cstr_name cstr; tag_name = get_tag_name cstr; cstr_untagged = get_untagged cstr} in let consts, blocks = Ext_list.fold_left cstrs ([], []) (fun (consts, blocks) cstr -> if is_nullary_variant cstr.cd_args then diff --git a/jscomp/frontend/ast_attributes.ml b/jscomp/frontend/ast_attributes.ml index 1204d90ac7..869dcafcc7 100644 --- a/jscomp/frontend/ast_attributes.ml +++ b/jscomp/frontend/ast_attributes.ml @@ -395,6 +395,15 @@ let process_tag_name (attrs : t) = | _ -> ()); !st +let process_untagged (attrs : t) = + let st = ref false in + Ext_list.iter attrs (fun (({ txt }, _)) -> + match txt with + | "unboxed" -> st := true + | _ -> ()); + !st + + let locg = Location.none (* let bs : attr = {txt = "bs" ; loc = locg}, Ast_payload.empty *) diff --git a/jscomp/frontend/ast_attributes.mli b/jscomp/frontend/ast_attributes.mli index 7ab5bdcc05..286e0f68be 100644 --- a/jscomp/frontend/ast_attributes.mli +++ b/jscomp/frontend/ast_attributes.mli @@ -95,3 +95,4 @@ val process_send_pipe : t -> (Parsetree.core_type * t) option val process_as_value : t -> Lambda.as_value option val process_tag_name : t -> string option +val process_untagged : t -> bool diff --git a/jscomp/ml/lambda.ml b/jscomp/ml/lambda.ml index bd5f6684f3..4facb5480c 100644 --- a/jscomp/ml/lambda.ml +++ b/jscomp/ml/lambda.ml @@ -38,7 +38,12 @@ type record_repr = | Record_regular | Record_optional -type as_value = AsString of string | AsInt of int | AsFloat of string | AsBool of bool | AsNull | AsUndefined | AsUnboxed +type as_untagged = + | IntType | StringType +type as_value = + | AsString of string | AsInt of int | AsFloat of string | AsBool of bool | AsNull | AsUndefined + | AsUnboxed + | AsUntagged of as_untagged type cstr_name = {name: string; as_value: as_value option} type tag_info = @@ -273,7 +278,9 @@ type function_attribute = { return_unit : bool; async : bool; } -type block = {cstr_name: cstr_name; tag_name: string option} + +type untagged = Unothing | Uint | Ustring +type block = {cstr_name: cstr_name; tag_name: string option; cstr_untagged : untagged} type switch_names = {consts: cstr_name array; blocks: block array} type lambda = diff --git a/jscomp/ml/lambda.mli b/jscomp/ml/lambda.mli index 5718493ecf..4f64c3434a 100644 --- a/jscomp/ml/lambda.mli +++ b/jscomp/ml/lambda.mli @@ -38,7 +38,12 @@ type record_repr = | Record_regular | Record_optional -type as_value = AsString of string | AsInt of int | AsFloat of string | AsBool of bool | AsNull | AsUndefined | AsUnboxed +type as_untagged = + | IntType | StringType +type as_value = + | AsString of string | AsInt of int | AsFloat of string | AsBool of bool | AsNull | AsUndefined + | AsUnboxed + | AsUntagged of as_untagged type cstr_name = {name:string; as_value: as_value option} type tag_info = @@ -276,7 +281,8 @@ type function_attribute = { async : bool; } -type block = {cstr_name: cstr_name; tag_name: string option} +type untagged = Unothing | Uint | Ustring +type block = {cstr_name: cstr_name; tag_name: string option; cstr_untagged : untagged} type switch_names = {consts: cstr_name array; blocks: block array} type lambda = diff --git a/jscomp/ml/matching.ml b/jscomp/ml/matching.ml index 8925357c3f..da8c154eb8 100644 --- a/jscomp/ml/matching.ml +++ b/jscomp/ml/matching.ml @@ -1332,6 +1332,7 @@ let make_constr_matching p def ctx = function let newargs = if cstr.cstr_inlined <> None || Ext_list.exists cstr.cstr_attributes (function + | ({txt="unboxed"}, _) | ({txt="as"}, PStr [{pstr_desc = Pstr_eval ({pexp_desc = Pexp_ident {txt= Lident "unboxed"}}, _)}]) -> true | _ -> false) then diff --git a/jscomp/ml/typedecl.ml b/jscomp/ml/typedecl.ml index 8dfe1bca78..f7bde76c2b 100644 --- a/jscomp/ml/typedecl.ml +++ b/jscomp/ml/typedecl.ml @@ -305,7 +305,12 @@ let transl_declaration env sdecl id = let raw_status = get_unboxed_from_attributes sdecl in let checkUntaggedVariant = match sdecl.ptype_kind with - | Ptype_variant _ -> true + | Ptype_variant cds -> Ext_list.for_all cds (function + | {pcd_args = Pcstr_tuple ([] | [_])} -> + (* at most one payload allowed for untagged variants *) + true + | {pcd_args = Pcstr_record _} -> true + | _ -> false ) | _ -> false in @@ -344,7 +349,7 @@ let transl_declaration env sdecl id = end; let unboxed_status = match sdecl.ptype_kind with - | Ptype_variant [{pcd_args = Pcstr_tuple [_]; _}] + | Ptype_variant [{pcd_args = Pcstr_tuple _; _}] | Ptype_variant [{pcd_args = Pcstr_record [{pld_mutable = Immutable; _}]; _}] | Ptype_record [{pld_mutable = Immutable; _}] -> @@ -386,8 +391,8 @@ let transl_declaration env sdecl id = all_constrs := StringSet.add name !all_constrs) scstrs; let copy_tag_attr_from_decl attr = - let tag_attr = Ext_list.filter sdecl.ptype_attributes (fun ({txt}, _) -> txt = "tag") in - if tag_attr = [] then attr else tag_attr @ attr in + let tag_attrs = Ext_list.filter sdecl.ptype_attributes (fun ({txt}, _) -> txt = "tag" || txt = "unboxed") in + if tag_attrs = [] then attr else tag_attrs @ attr in let make_cstr scstr = let name = Ident.create scstr.pcd_name.txt in let targs, tret_type, args, ret_type, _cstr_params = diff --git a/jscomp/test/UntaggedVariants.js b/jscomp/test/UntaggedVariants.js index 4e2a5abf10..4df51dc8a9 100644 --- a/jscomp/test/UntaggedVariants.js +++ b/jscomp/test/UntaggedVariants.js @@ -2,24 +2,76 @@ function classify(x) { - if (x.TAG === "I") { + if (typeof x !== "string" && typeof x !== "number") { + return "A"; + } else if (typeof x === "number") { return "An integer"; } else { - return "A string"; + return "A string" + x; } } -var i = { - TAG: "I", - _0: 42 -}; +function cls(x) { + if (typeof x !== "object") { + if (x === "One") { + return "one"; + } else { + return "two"; + } + } else { + return "object" + x.y; + } +} + +var ListWithTuples = {}; + +var ListWithObjects = {}; + +function tuplesToObjects(l) { + if (l === undefined) { + return null; + } else { + return { + hd: l[0], + tl: tuplesToObjects(l[1]) + }; + } +} + +var l1 = [ + 1, + [ + 2, + [ + 3, + undefined + ] + ] +]; + +var l2 = tuplesToObjects(l1); + +console.log("l1", l1); + +console.log("l2", l2); + +var i = 42; + +var s = "abc"; -var s = { - TAG: "S", - _0: "abc" +var w = { + x: 10, + y: "" }; exports.i = i; exports.s = s; exports.classify = classify; -/* No side effect */ +exports.w = w; +exports.cls = cls; +exports.ListWithTuples = ListWithTuples; +exports.ListWithObjects = ListWithObjects; +exports.tuplesToObjects = tuplesToObjects; +exports.l1 = l1; +exports.l2 = l2; +/* l2 Not a pure module */ diff --git a/jscomp/test/UntaggedVariants.res b/jscomp/test/UntaggedVariants.res index 6b1c205b7c..d50fc7f510 100644 --- a/jscomp/test/UntaggedVariants.res +++ b/jscomp/test/UntaggedVariants.res @@ -1,5 +1,5 @@ @unboxed -type t = I(int) | S(string) +type t = A | I(int) | S(string) let i = I(42) let s = S("abc") @@ -7,5 +7,39 @@ let s = S("abc") let classify = x => switch x { | I(_) => "An integer" - | S(_) => "A string" + | S(s) => "A string" ++ s + | A => "A" } + +@unboxed +type tt = One | Two | Object({x: int, y: string}) + +let w = Object({x: 10, y: ""}) + +let cls = x => + switch x { + | One => "one" + | Two => "two" + | Object({y}) => "object" ++ y + } + +module ListWithTuples = { + @unboxed + type rec t<'a> = | @as(undefined) Empty | Cons(('a, t<'a>)) +} + +module ListWithObjects = { + @unboxed + type rec t<'a> = | @as(null) Empty | Cons({hd: 'a, tl: t<'a>}) +} + +let rec tuplesToObjects = (l: ListWithTuples.t<_>): ListWithObjects.t<_> => + switch l { + | Empty => Empty + | Cons((hd, tl)) => Cons({hd, tl: tuplesToObjects(tl)}) + } + +let l1 = ListWithTuples.Cons((1, Cons((2, Cons((3, Empty)))))) +let l2 = tuplesToObjects(l1) +Js.log2("l1", l1) +Js.log2("l2", l2) From 62a586f383d01fe1a245c2a1d3dd800cd2de8746 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Thu, 30 Mar 2023 18:24:24 +0200 Subject: [PATCH 03/31] No need for @as(unboxed) anymore. --- jscomp/core/js_dump.ml | 6 +++--- jscomp/core/js_exp_make.ml | 2 -- jscomp/core/js_stmt_make.ml | 2 +- jscomp/core/lam_compile.ml | 2 +- jscomp/frontend/ast_attributes.ml | 3 --- jscomp/ml/lambda.ml | 1 - jscomp/ml/lambda.mli | 1 - jscomp/ml/matching.ml | 4 +--- jscomp/test/variantsMatching.res | 12 ++++++++---- 9 files changed, 14 insertions(+), 19 deletions(-) diff --git a/jscomp/core/js_dump.ml b/jscomp/core/js_dump.ml index 2957abf50c..ea3d7c239c 100644 --- a/jscomp/core/js_dump.ml +++ b/jscomp/core/js_dump.ml @@ -805,7 +805,7 @@ and expression_desc cxt ~(level : int) f x : cxt = [ (name_symbol, E.str p.name) ] else []) in - if untagged || (as_value = Some AsUnboxed || not_is_cons = false) && p.num_nonconst = 1 then tails + if untagged || (not_is_cons = false) && p.num_nonconst = 1 then tails else ( Js_op.Lit tag_name, (* TAG:xx *) match as_value with @@ -814,8 +814,8 @@ and expression_desc cxt ~(level : int) f x : cxt = :: tails in let exp = match objs with - | [(_, e)] when untagged || as_value = Some AsUnboxed -> e.expression_desc - | _ when untagged || as_value = Some AsUnboxed -> assert false (* should not happen *) + | [(_, e)] when untagged -> e.expression_desc + | _ when untagged -> assert false (* should not happen *) (* TODO: put restriction on the variant definitions allowed, to make sure this never happens. *) | _ -> J.Object objs in expression_desc cxt ~level f exp diff --git a/jscomp/core/js_exp_make.ml b/jscomp/core/js_exp_make.ml index 593c0e50f7..9931b02fdb 100644 --- a/jscomp/core/js_exp_make.ml +++ b/jscomp/core/js_exp_make.ml @@ -337,8 +337,6 @@ let as_value = function | AsUndefined -> undefined | AsUntagged IntType -> str "number" | AsUntagged StringType -> str "string" - | AsUnboxed -> assert false (* Should not emit tags for unboxed *) - (* TODO: put restriction on the variant definitions allowed, to make sure this never happens. *) let array_index ?comment (e0 : t) (e1 : t) : t = match (e0.expression_desc, e1.expression_desc) with diff --git a/jscomp/core/js_stmt_make.ml b/jscomp/core/js_stmt_make.ml index f487a32dac..879240a3d4 100644 --- a/jscomp/core/js_stmt_make.ml +++ b/jscomp/core/js_stmt_make.ml @@ -138,7 +138,7 @@ let string_switch ?(comment : string option) match switch_case with | AsString s -> if s = txt then Some x.switch_body else None - | AsInt _ | AsFloat _| AsBool _ | AsNull | AsUnboxed + | AsInt _ | AsFloat _| AsBool _ | AsNull | AsUndefined | AsUntagged _ -> None) with diff --git a/jscomp/core/lam_compile.ml b/jscomp/core/lam_compile.ml index bf69e24b12..b4f10cb6d5 100644 --- a/jscomp/core/lam_compile.ml +++ b/jscomp/core/lam_compile.ml @@ -720,7 +720,7 @@ and compile_string_cases cxt switch_exp table default = let add_runtime_type_check (as_value: Lambda.as_value) x = match as_value with | AsUntagged IntType | AsUntagged StringType -> E.typeof x - | AsBool _ | AsFloat _ | AsInt _ | AsString _ | AsNull | AsUnboxed | AsUndefined -> x in + | AsBool _ | AsFloat _ | AsInt _ | AsString _ | AsNull | AsUndefined -> x in let mk_eq (i : Lambda.as_value option) x j y = match i, j with | Some as_value, _ -> E.string_equal x (add_runtime_type_check as_value y) diff --git a/jscomp/frontend/ast_attributes.ml b/jscomp/frontend/ast_attributes.ml index 869dcafcc7..e9b30bde29 100644 --- a/jscomp/frontend/ast_attributes.ml +++ b/jscomp/frontend/ast_attributes.ml @@ -368,9 +368,6 @@ let process_as_value (attrs : t) = | Some Lident "undefined" -> Bs_ast_invariant.mark_used_bs_attribute attr; st := Some AsUndefined - | Some Lident "unboxed" -> - Bs_ast_invariant.mark_used_bs_attribute attr; - st := Some AsUnboxed | Some _ -> Bs_syntaxerr.err loc InvalidVariantAsAnnotation); if !st = None then Bs_syntaxerr.err loc InvalidVariantAsAnnotation ) diff --git a/jscomp/ml/lambda.ml b/jscomp/ml/lambda.ml index 4facb5480c..db324d9cd7 100644 --- a/jscomp/ml/lambda.ml +++ b/jscomp/ml/lambda.ml @@ -42,7 +42,6 @@ type as_untagged = | IntType | StringType type as_value = | AsString of string | AsInt of int | AsFloat of string | AsBool of bool | AsNull | AsUndefined - | AsUnboxed | AsUntagged of as_untagged type cstr_name = {name: string; as_value: as_value option} diff --git a/jscomp/ml/lambda.mli b/jscomp/ml/lambda.mli index 4f64c3434a..22929c44c6 100644 --- a/jscomp/ml/lambda.mli +++ b/jscomp/ml/lambda.mli @@ -42,7 +42,6 @@ type as_untagged = | IntType | StringType type as_value = | AsString of string | AsInt of int | AsFloat of string | AsBool of bool | AsNull | AsUndefined - | AsUnboxed | AsUntagged of as_untagged type cstr_name = {name:string; as_value: as_value option} diff --git a/jscomp/ml/matching.ml b/jscomp/ml/matching.ml index da8c154eb8..f271a92d22 100644 --- a/jscomp/ml/matching.ml +++ b/jscomp/ml/matching.ml @@ -1332,9 +1332,7 @@ let make_constr_matching p def ctx = function let newargs = if cstr.cstr_inlined <> None || Ext_list.exists cstr.cstr_attributes (function - | ({txt="unboxed"}, _) - | ({txt="as"}, PStr [{pstr_desc = Pstr_eval - ({pexp_desc = Pexp_ident {txt= Lident "unboxed"}}, _)}]) -> true + | ({txt="unboxed"}, _) -> true | _ -> false) then (arg, Alias) :: argl else match cstr.cstr_tag with diff --git a/jscomp/test/variantsMatching.res b/jscomp/test/variantsMatching.res index 8aeb67961e..40ac1b4de5 100644 --- a/jscomp/test/variantsMatching.res +++ b/jscomp/test/variantsMatching.res @@ -107,7 +107,8 @@ module CustomizeTags = { } module MyUndefined = { - type t<'a> = | @as(undefined) Undefined | @as(unboxed) Present('a) + @unboxed + type t<'a> = | @as(undefined) Undefined | Present('a) // Note: 'a must not have undefined as value // There can be only one with payload, with 1 argument, to use unboxed @@ -124,7 +125,8 @@ module MyUndefined = { } module MyNull = { - type t<'a> = | @as(null) Null | @as(unboxed) Present('a) + @unboxed + type t<'a> = | @as(null) Null | Present('a) // Note: 'a must not have null as value // There can be only one with payload, with 1 argument, to use unboxed @@ -141,10 +143,11 @@ module MyNull = { } module MyNullable = { + @unboxed type t<'a> = | @as(null) Null | @as(undefined) Undefined - | @as(unboxed) Present('a) + | Present('a) // Note: 'a must not have null or undefined as value // There can be only one with payload, with 1 argument, to use unboxed @@ -173,10 +176,11 @@ module MyNullable = { } module MyNullableExtended = { + @unboxed type t<'a> = | @as(null) Null | @as(undefined) Undefined - | @as(unboxed) Present('a) + | Present('a) | WhyNotAnotherOne // Note: 'a must be a not have null or something that's not an object as value // There can be only one with payload, with 1 argument, to use unboxed From fcf8df2a2a1cd76d6c815283a49cbbb38e848806 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Thu, 30 Mar 2023 18:37:31 +0200 Subject: [PATCH 04/31] Move type defs around. --- jscomp/core/js_exp_make.ml | 2 +- jscomp/core/js_exp_make.mli | 2 +- jscomp/ml/lambda.ml | 16 ++++++++-------- jscomp/ml/lambda.mli | 17 ++++++++--------- 4 files changed, 18 insertions(+), 19 deletions(-) diff --git a/jscomp/core/js_exp_make.ml b/jscomp/core/js_exp_make.ml index 9931b02fdb..2f81e4225f 100644 --- a/jscomp/core/js_exp_make.ml +++ b/jscomp/core/js_exp_make.ml @@ -763,7 +763,7 @@ let is_type_number ?comment (e : t) : t = string_equal ?comment (typeof e) (str "number") let rec is_not_untagged ~untagged_cases (e:t) : t = - let is_case (c:Lambda.untagged) : t = match c with + let is_case (c:Lambda.cstr_untagged) : t = match c with | Unothing -> assert false | Ustring -> { expression_desc = Bin (NotEqEq, typeof e, str "string"); comment=None } | Uint -> { expression_desc = Bin (NotEqEq, typeof e, str "number"); comment=None } diff --git a/jscomp/core/js_exp_make.mli b/jscomp/core/js_exp_make.mli index e4b2e53579..88c14f0338 100644 --- a/jscomp/core/js_exp_make.mli +++ b/jscomp/core/js_exp_make.mli @@ -204,7 +204,7 @@ val is_type_number : ?comment:string -> t -> t val is_tag : ?has_null_undefined_other:(bool * bool * bool) -> t -> t -val is_not_untagged : untagged_cases:Lambda.untagged list -> t -> t +val is_not_untagged : untagged_cases:Lambda.cstr_untagged list -> t -> t val is_type_string : ?comment:string -> t -> t diff --git a/jscomp/ml/lambda.ml b/jscomp/ml/lambda.ml index db324d9cd7..f28eeb603c 100644 --- a/jscomp/ml/lambda.ml +++ b/jscomp/ml/lambda.ml @@ -38,12 +38,6 @@ type record_repr = | Record_regular | Record_optional -type as_untagged = - | IntType | StringType -type as_value = - | AsString of string | AsInt of int | AsFloat of string | AsBool of bool | AsNull | AsUndefined - | AsUntagged of as_untagged -type cstr_name = {name: string; as_value: as_value option} type tag_info = | Blk_constructor of {name : string ; num_nonconst : int ; tag : int; attrs : Parsetree.attributes } @@ -278,8 +272,14 @@ type function_attribute = { async : bool; } -type untagged = Unothing | Uint | Ustring -type block = {cstr_name: cstr_name; tag_name: string option; cstr_untagged : untagged} +type as_untagged = + | IntType | StringType +type as_value = + | AsString of string | AsInt of int | AsFloat of string | AsBool of bool | AsNull | AsUndefined + | AsUntagged of as_untagged +type cstr_name = {name: string; as_value: as_value option} +type cstr_untagged = Unothing | Uint | Ustring +type block = {cstr_name: cstr_name; tag_name: string option; cstr_untagged : cstr_untagged} type switch_names = {consts: cstr_name array; blocks: block array} type lambda = diff --git a/jscomp/ml/lambda.mli b/jscomp/ml/lambda.mli index 22929c44c6..f2cf786f7e 100644 --- a/jscomp/ml/lambda.mli +++ b/jscomp/ml/lambda.mli @@ -38,13 +38,6 @@ type record_repr = | Record_regular | Record_optional -type as_untagged = - | IntType | StringType -type as_value = - | AsString of string | AsInt of int | AsFloat of string | AsBool of bool | AsNull | AsUndefined - | AsUntagged of as_untagged -type cstr_name = {name:string; as_value: as_value option} - type tag_info = | Blk_constructor of { name : string ; num_nonconst : int; tag : int; attrs : Parsetree.attributes } | Blk_record_inlined of { name : string ; num_nonconst : int ; tag : int; optional_labels: string list; fields : string array; mutable_flag : mutable_flag; attrs : Parsetree.attributes } @@ -280,8 +273,14 @@ type function_attribute = { async : bool; } -type untagged = Unothing | Uint | Ustring -type block = {cstr_name: cstr_name; tag_name: string option; cstr_untagged : untagged} +type as_untagged = + | IntType | StringType +type as_value = + | AsString of string | AsInt of int | AsFloat of string | AsBool of bool | AsNull | AsUndefined + | AsUntagged of as_untagged +type cstr_name = {name:string; as_value: as_value option} +type cstr_untagged = Unothing | Uint | Ustring +type block = {cstr_name: cstr_name; tag_name: string option; cstr_untagged : cstr_untagged} type switch_names = {consts: cstr_name array; blocks: block array} type lambda = From f23ed76b4158154f37d365109a17684b5f4e45f7 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Thu, 30 Mar 2023 18:46:52 +0200 Subject: [PATCH 05/31] Unify type definitions for untagged. --- jscomp/core/js_exp_make.ml | 7 +++---- jscomp/core/js_exp_make.mli | 2 +- jscomp/core/lam_compile.ml | 15 +++++++-------- jscomp/core/matching_polyfill.ml | 8 ++++---- jscomp/ml/lambda.ml | 3 +-- jscomp/ml/lambda.mli | 6 ++---- 6 files changed, 18 insertions(+), 23 deletions(-) diff --git a/jscomp/core/js_exp_make.ml b/jscomp/core/js_exp_make.ml index 2f81e4225f..4bfb598a4d 100644 --- a/jscomp/core/js_exp_make.ml +++ b/jscomp/core/js_exp_make.ml @@ -763,10 +763,9 @@ let is_type_number ?comment (e : t) : t = string_equal ?comment (typeof e) (str "number") let rec is_not_untagged ~untagged_cases (e:t) : t = - let is_case (c:Lambda.cstr_untagged) : t = match c with - | Unothing -> assert false - | Ustring -> { expression_desc = Bin (NotEqEq, typeof e, str "string"); comment=None } - | Uint -> { expression_desc = Bin (NotEqEq, typeof e, str "number"); comment=None } + let is_case (c:Lambda.as_untagged) : t = match c with + | Lambda.StringType -> { expression_desc = Bin (NotEqEq, typeof e, str "string"); comment=None } + | IntType -> { expression_desc = Bin (NotEqEq, typeof e, str "number"); comment=None } in match untagged_cases with | [c] -> is_case c diff --git a/jscomp/core/js_exp_make.mli b/jscomp/core/js_exp_make.mli index 88c14f0338..662e2dbe54 100644 --- a/jscomp/core/js_exp_make.mli +++ b/jscomp/core/js_exp_make.mli @@ -204,7 +204,7 @@ val is_type_number : ?comment:string -> t -> t val is_tag : ?has_null_undefined_other:(bool * bool * bool) -> t -> t -val is_not_untagged : untagged_cases:Lambda.cstr_untagged list -> t -> t +val is_not_untagged : untagged_cases:Lambda.as_untagged list -> t -> t val is_type_string : ?comment:string -> t -> t diff --git a/jscomp/core/lam_compile.ml b/jscomp/core/lam_compile.ml index b4f10cb6d5..129ac33538 100644 --- a/jscomp/core/lam_compile.ml +++ b/jscomp/core/lam_compile.ml @@ -158,9 +158,10 @@ let get_untagged_cases (sw_names : Lambda.switch_names option) = (match sw_names with | None -> res := [] | Some { blocks } -> - Array.iter (fun {Lambda.cstr_untagged} -> - if cstr_untagged <> Unothing - then res := cstr_untagged :: !res) blocks + Array.iter (function + | {Lambda.cstr_untagged = Some cstr_untagged} -> res := cstr_untagged :: !res + | {Lambda.cstr_untagged = None} -> () + ) blocks ); !res @@ -654,11 +655,9 @@ and compile_switch (switch_arg : Lam.t) (sw : Lam.lambda_switch) let untagged_cases = get_untagged_cases sw_names in let get_block_name i = match get_block i with | None -> None - | Some ({cstr_untagged = Uint} as block) -> - Some {block.cstr_name with as_value = Some (AsUntagged IntType)} - | Some ({cstr_untagged = Ustring} as block) -> - Some {block.cstr_name with as_value = Some (AsUntagged StringType)} - | Some ({cstr_untagged = Unothing; cstr_name}) -> + | Some ({cstr_untagged = Some as_untagged} as block) -> + Some {block.cstr_name with as_value = Some (AsUntagged as_untagged)} + | Some ({cstr_untagged = None; cstr_name}) -> Some cstr_name in let tag_name = get_tag_name sw_names in let compile_whole (cxt : Lam_compile_context.t) = diff --git a/jscomp/core/matching_polyfill.ml b/jscomp/core/matching_polyfill.ml index 2a35a6a12e..a2b241502b 100644 --- a/jscomp/core/matching_polyfill.ml +++ b/jscomp/core/matching_polyfill.ml @@ -34,10 +34,10 @@ let names_from_construct_pattern (pat : Typedtree.pattern) = Ast_attributes.process_tag_name cstr.cd_attributes in let get_untagged (cstr: Types.constructor_declaration) = match Ast_attributes.process_untagged cstr.cd_attributes, cstr.cd_args with - | false, _ -> Lambda.Unothing - | true, Cstr_tuple [{desc = Tconstr (path, _, _)}] when Path.same path Predef.path_string -> Ustring - | true, Cstr_tuple [{desc = Tconstr (path, _, _)}] when Path.same path Predef.path_int -> Uint - | true, _ -> Unothing + | false, _ -> None + | true, Cstr_tuple [{desc = Tconstr (path, _, _)}] when Path.same path Predef.path_string -> Some Lambda.StringType + | true, Cstr_tuple [{desc = Tconstr (path, _, _)}] when Path.same path Predef.path_int -> Some IntType + | true, _ -> None in let get_block cstr : Lambda.block = {cstr_name = get_cstr_name cstr; tag_name = get_tag_name cstr; cstr_untagged = get_untagged cstr} in diff --git a/jscomp/ml/lambda.ml b/jscomp/ml/lambda.ml index f28eeb603c..9daf572275 100644 --- a/jscomp/ml/lambda.ml +++ b/jscomp/ml/lambda.ml @@ -278,8 +278,7 @@ type as_value = | AsString of string | AsInt of int | AsFloat of string | AsBool of bool | AsNull | AsUndefined | AsUntagged of as_untagged type cstr_name = {name: string; as_value: as_value option} -type cstr_untagged = Unothing | Uint | Ustring -type block = {cstr_name: cstr_name; tag_name: string option; cstr_untagged : cstr_untagged} +type block = {cstr_name: cstr_name; tag_name: string option; cstr_untagged : as_untagged option} type switch_names = {consts: cstr_name array; blocks: block array} type lambda = diff --git a/jscomp/ml/lambda.mli b/jscomp/ml/lambda.mli index f2cf786f7e..73ede194a3 100644 --- a/jscomp/ml/lambda.mli +++ b/jscomp/ml/lambda.mli @@ -273,14 +273,12 @@ type function_attribute = { async : bool; } -type as_untagged = - | IntType | StringType +type as_untagged = IntType | StringType type as_value = | AsString of string | AsInt of int | AsFloat of string | AsBool of bool | AsNull | AsUndefined | AsUntagged of as_untagged type cstr_name = {name:string; as_value: as_value option} -type cstr_untagged = Unothing | Uint | Ustring -type block = {cstr_name: cstr_name; tag_name: string option; cstr_untagged : cstr_untagged} +type block = {cstr_name: cstr_name; tag_name: string option; cstr_untagged : as_untagged option} type switch_names = {consts: cstr_name array; blocks: block array} type lambda = From ef8857ec30e5033c7675479eabdb7431756cb4cc Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Thu, 30 Mar 2023 18:47:33 +0200 Subject: [PATCH 06/31] Example of boolean config. --- jscomp/test/UntaggedVariants.js | 13 +++++++++++++ jscomp/test/UntaggedVariants.res | 11 +++++++++++ 2 files changed, 24 insertions(+) diff --git a/jscomp/test/UntaggedVariants.js b/jscomp/test/UntaggedVariants.js index 4df51dc8a9..1fc30d7087 100644 --- a/jscomp/test/UntaggedVariants.js +++ b/jscomp/test/UntaggedVariants.js @@ -55,6 +55,18 @@ console.log("l1", l1); console.log("l2", l2); +function isTrue(x) { + if (typeof x !== "object") { + return true; + } else { + return x.flag; + } +} + +var Truthy = { + isTrue: isTrue +}; + var i = 42; var s = "abc"; @@ -74,4 +86,5 @@ exports.ListWithObjects = ListWithObjects; exports.tuplesToObjects = tuplesToObjects; exports.l1 = l1; exports.l2 = l2; +exports.Truthy = Truthy; /* l2 Not a pure module */ diff --git a/jscomp/test/UntaggedVariants.res b/jscomp/test/UntaggedVariants.res index d50fc7f510..2b4dc00f28 100644 --- a/jscomp/test/UntaggedVariants.res +++ b/jscomp/test/UntaggedVariants.res @@ -43,3 +43,14 @@ let l1 = ListWithTuples.Cons((1, Cons((2, Cons((3, Empty)))))) let l2 = tuplesToObjects(l1) Js.log2("l1", l1) Js.log2("l2", l2) + +module Truthy = { + @unboxed + type t = | @as(true) True | Obj({flag: bool}) + + let isTrue = x => + switch x { + | True => true + | Obj({flag}) => flag + } +} From 19ca48a7c216ed3147fa42ea9a71d1cbe3e94f5b Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Thu, 30 Mar 2023 19:04:25 +0200 Subject: [PATCH 07/31] Add handling of float. --- jscomp/core/js_exp_make.ml | 2 ++ jscomp/core/lam_compile.ml | 3 ++- jscomp/core/matching_polyfill.ml | 3 ++- jscomp/ml/lambda.ml | 2 +- jscomp/ml/lambda.mli | 2 +- jscomp/test/UntaggedVariants.js | 15 +++++++++++++++ jscomp/test/UntaggedVariants.res | 10 ++++++++++ 7 files changed, 33 insertions(+), 4 deletions(-) diff --git a/jscomp/core/js_exp_make.ml b/jscomp/core/js_exp_make.ml index 4bfb598a4d..2d515e2c21 100644 --- a/jscomp/core/js_exp_make.ml +++ b/jscomp/core/js_exp_make.ml @@ -336,6 +336,7 @@ let as_value = function | AsNull -> nil | AsUndefined -> undefined | AsUntagged IntType -> str "number" + | AsUntagged FloatType -> str "number" | AsUntagged StringType -> str "string" let array_index ?comment (e0 : t) (e1 : t) : t = @@ -766,6 +767,7 @@ let rec is_not_untagged ~untagged_cases (e:t) : t = let is_case (c:Lambda.as_untagged) : t = match c with | Lambda.StringType -> { expression_desc = Bin (NotEqEq, typeof e, str "string"); comment=None } | IntType -> { expression_desc = Bin (NotEqEq, typeof e, str "number"); comment=None } + | FloatType -> { expression_desc = Bin (NotEqEq, typeof e, str "number"); comment=None } in match untagged_cases with | [c] -> is_case c diff --git a/jscomp/core/lam_compile.ml b/jscomp/core/lam_compile.ml index 129ac33538..4fdcecc05e 100644 --- a/jscomp/core/lam_compile.ml +++ b/jscomp/core/lam_compile.ml @@ -718,7 +718,8 @@ and compile_string_cases cxt switch_exp table default = in let add_runtime_type_check (as_value: Lambda.as_value) x = match as_value with | AsUntagged IntType - | AsUntagged StringType -> E.typeof x + | AsUntagged StringType + | AsUntagged FloatType -> E.typeof x | AsBool _ | AsFloat _ | AsInt _ | AsString _ | AsNull | AsUndefined -> x in let mk_eq (i : Lambda.as_value option) x j y = match i, j with | Some as_value, _ -> diff --git a/jscomp/core/matching_polyfill.ml b/jscomp/core/matching_polyfill.ml index a2b241502b..b1da948aa7 100644 --- a/jscomp/core/matching_polyfill.ml +++ b/jscomp/core/matching_polyfill.ml @@ -37,7 +37,8 @@ let names_from_construct_pattern (pat : Typedtree.pattern) = | false, _ -> None | true, Cstr_tuple [{desc = Tconstr (path, _, _)}] when Path.same path Predef.path_string -> Some Lambda.StringType | true, Cstr_tuple [{desc = Tconstr (path, _, _)}] when Path.same path Predef.path_int -> Some IntType - | true, _ -> None + | true, Cstr_tuple [{desc = Tconstr (path, _, _)}] when Path.same path Predef.path_float -> Some FloatType + | true, _ -> None (* TODO: add restrictions here *) in let get_block cstr : Lambda.block = {cstr_name = get_cstr_name cstr; tag_name = get_tag_name cstr; cstr_untagged = get_untagged cstr} in diff --git a/jscomp/ml/lambda.ml b/jscomp/ml/lambda.ml index 9daf572275..5aab104af9 100644 --- a/jscomp/ml/lambda.ml +++ b/jscomp/ml/lambda.ml @@ -273,7 +273,7 @@ type function_attribute = { } type as_untagged = - | IntType | StringType + | IntType | StringType | FloatType type as_value = | AsString of string | AsInt of int | AsFloat of string | AsBool of bool | AsNull | AsUndefined | AsUntagged of as_untagged diff --git a/jscomp/ml/lambda.mli b/jscomp/ml/lambda.mli index 73ede194a3..a81d8c6e10 100644 --- a/jscomp/ml/lambda.mli +++ b/jscomp/ml/lambda.mli @@ -273,7 +273,7 @@ type function_attribute = { async : bool; } -type as_untagged = IntType | StringType +type as_untagged = IntType | StringType | FloatType type as_value = | AsString of string | AsInt of int | AsFloat of string | AsBool of bool | AsNull | AsUndefined | AsUntagged of as_untagged diff --git a/jscomp/test/UntaggedVariants.js b/jscomp/test/UntaggedVariants.js index 1fc30d7087..ad75d4eac3 100644 --- a/jscomp/test/UntaggedVariants.js +++ b/jscomp/test/UntaggedVariants.js @@ -11,6 +11,14 @@ function classify(x) { } } +function classify2(x) { + if (typeof x === "string") { + return "A string" + x; + } else { + return "A float"; + } +} + function cls(x) { if (typeof x !== "object") { if (x === "One") { @@ -69,16 +77,23 @@ var Truthy = { var i = 42; +var i2 = 42.5; + var s = "abc"; +var s2 = "abc"; + var w = { x: 10, y: "" }; exports.i = i; +exports.i2 = i2; exports.s = s; +exports.s2 = s2; exports.classify = classify; +exports.classify2 = classify2; exports.w = w; exports.cls = cls; exports.ListWithTuples = ListWithTuples; diff --git a/jscomp/test/UntaggedVariants.res b/jscomp/test/UntaggedVariants.res index 2b4dc00f28..02e3a568d7 100644 --- a/jscomp/test/UntaggedVariants.res +++ b/jscomp/test/UntaggedVariants.res @@ -1,8 +1,12 @@ @unboxed type t = A | I(int) | S(string) +@unboxed +type t2 = S2(string) | I2(float) let i = I(42) +let i2 = I2(42.5) let s = S("abc") +let s2 = S2("abc") let classify = x => switch x { @@ -11,6 +15,12 @@ let classify = x => | A => "A" } +let classify2 = x => + switch x { + | I2(_) => "A float" + | S2(s) => "A string" ++ s + } + @unboxed type tt = One | Two | Object({x: int, y: string}) From dead95b571aa2c75170d09acf052f8a7fb73fc58 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Thu, 30 Mar 2023 19:11:10 +0200 Subject: [PATCH 08/31] Add example with 2 object types. --- jscomp/test/UntaggedVariants.js | 17 +++++++++++++++++ jscomp/test/UntaggedVariants.res | 12 ++++++++++++ 2 files changed, 29 insertions(+) diff --git a/jscomp/test/UntaggedVariants.js b/jscomp/test/UntaggedVariants.js index ad75d4eac3..c2c592bb71 100644 --- a/jscomp/test/UntaggedVariants.js +++ b/jscomp/test/UntaggedVariants.js @@ -75,6 +75,22 @@ var Truthy = { isTrue: isTrue }; +function classify$1(x) { + if (x === null || x === undefined) { + if (x === null) { + return "null"; + } else { + return "undefined"; + } + } else { + return "object" + x.name; + } +} + +var TwoObjects = { + classify: classify$1 +}; + var i = 42; var i2 = 42.5; @@ -102,4 +118,5 @@ exports.tuplesToObjects = tuplesToObjects; exports.l1 = l1; exports.l2 = l2; exports.Truthy = Truthy; +exports.TwoObjects = TwoObjects; /* l2 Not a pure module */ diff --git a/jscomp/test/UntaggedVariants.res b/jscomp/test/UntaggedVariants.res index 02e3a568d7..44f261836d 100644 --- a/jscomp/test/UntaggedVariants.res +++ b/jscomp/test/UntaggedVariants.res @@ -64,3 +64,15 @@ module Truthy = { | Obj({flag}) => flag } } + +module TwoObjects = { + @unwrapped + type t = | @as(null) Null | Object({name: string}) | @as(undefined) Undefined + + let classify = x => + switch x { + | Null => "null" + | Object({name}) => "object" ++ name + | Undefined => "undefined" + } +} From cbc265652ef06f648f5f2c328fa66d6e037dda8c Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Fri, 31 Mar 2023 08:46:30 +0200 Subject: [PATCH 09/31] Add partial treatment of unknown. wip --- jscomp/core/js_exp_make.ml | 4 +++ jscomp/core/lam_compile.ml | 3 ++ jscomp/core/matching_polyfill.ml | 1 + jscomp/ml/lambda.ml | 2 +- jscomp/ml/lambda.mli | 2 +- jscomp/test/UntaggedVariants.js | 48 ++++++++++++++++++++++++++++++++ jscomp/test/UntaggedVariants.res | 33 +++++++++++++++++++++- jscomp/test/variantsMatching.js | 22 +++++++-------- 8 files changed, 101 insertions(+), 14 deletions(-) diff --git a/jscomp/core/js_exp_make.ml b/jscomp/core/js_exp_make.ml index 2d515e2c21..24247c39ae 100644 --- a/jscomp/core/js_exp_make.ml +++ b/jscomp/core/js_exp_make.ml @@ -338,6 +338,9 @@ let as_value = function | AsUntagged IntType -> str "number" | AsUntagged FloatType -> str "number" | AsUntagged StringType -> str "string" + | AsUntagged Unknown -> + (* TODO: clean up pattern mathing algo whih confuses literal with blocks *) + assert false let array_index ?comment (e0 : t) (e1 : t) : t = match (e0.expression_desc, e1.expression_desc) with @@ -768,6 +771,7 @@ let rec is_not_untagged ~untagged_cases (e:t) : t = | Lambda.StringType -> { expression_desc = Bin (NotEqEq, typeof e, str "string"); comment=None } | IntType -> { expression_desc = Bin (NotEqEq, typeof e, str "number"); comment=None } | FloatType -> { expression_desc = Bin (NotEqEq, typeof e, str "number"); comment=None } + | Unknown -> { expression_desc = Bin (NotEqEq, typeof e, str "???typ"); comment=None } in match untagged_cases with | [c] -> is_case c diff --git a/jscomp/core/lam_compile.ml b/jscomp/core/lam_compile.ml index 4fdcecc05e..ac4b615448 100644 --- a/jscomp/core/lam_compile.ml +++ b/jscomp/core/lam_compile.ml @@ -720,6 +720,9 @@ and compile_string_cases cxt switch_exp table default = | AsUntagged IntType | AsUntagged StringType | AsUntagged FloatType -> E.typeof x + | AsUntagged Unknown -> + (* This should not happen because unknown must be the only non-literal case *) + assert false | AsBool _ | AsFloat _ | AsInt _ | AsString _ | AsNull | AsUndefined -> x in let mk_eq (i : Lambda.as_value option) x j y = match i, j with | Some as_value, _ -> diff --git a/jscomp/core/matching_polyfill.ml b/jscomp/core/matching_polyfill.ml index b1da948aa7..30772b053b 100644 --- a/jscomp/core/matching_polyfill.ml +++ b/jscomp/core/matching_polyfill.ml @@ -38,6 +38,7 @@ let names_from_construct_pattern (pat : Typedtree.pattern) = | true, Cstr_tuple [{desc = Tconstr (path, _, _)}] when Path.same path Predef.path_string -> Some Lambda.StringType | true, Cstr_tuple [{desc = Tconstr (path, _, _)}] when Path.same path Predef.path_int -> Some IntType | true, Cstr_tuple [{desc = Tconstr (path, _, _)}] when Path.same path Predef.path_float -> Some FloatType + | true, Cstr_tuple [{desc = Tvar _ | Tlink ({desc = Tvar _})}] -> Some Unknown | true, _ -> None (* TODO: add restrictions here *) in let get_block cstr : Lambda.block = diff --git a/jscomp/ml/lambda.ml b/jscomp/ml/lambda.ml index 5aab104af9..ae864aa283 100644 --- a/jscomp/ml/lambda.ml +++ b/jscomp/ml/lambda.ml @@ -273,7 +273,7 @@ type function_attribute = { } type as_untagged = - | IntType | StringType | FloatType + | IntType | StringType | FloatType | Unknown type as_value = | AsString of string | AsInt of int | AsFloat of string | AsBool of bool | AsNull | AsUndefined | AsUntagged of as_untagged diff --git a/jscomp/ml/lambda.mli b/jscomp/ml/lambda.mli index a81d8c6e10..755b33915d 100644 --- a/jscomp/ml/lambda.mli +++ b/jscomp/ml/lambda.mli @@ -273,7 +273,7 @@ type function_attribute = { async : bool; } -type as_untagged = IntType | StringType | FloatType +type as_untagged = IntType | StringType | FloatType | Unknown type as_value = | AsString of string | AsInt of int | AsFloat of string | AsBool of bool | AsNull | AsUndefined | AsUntagged of as_untagged diff --git a/jscomp/test/UntaggedVariants.js b/jscomp/test/UntaggedVariants.js index c2c592bb71..9d04912799 100644 --- a/jscomp/test/UntaggedVariants.js +++ b/jscomp/test/UntaggedVariants.js @@ -91,6 +91,52 @@ var TwoObjects = { classify: classify$1 }; +function classify$2(x) { + if (typeof x !== "???typ") { + if (x === "A") { + return "a"; + } else { + return "b"; + } + } + console.log(x); + return "Unknown"; +} + +var Unknown = { + classify: classify$2 +}; + +function classify$3(x) { + if (typeof x !== "number" && typeof x !== "string") { + switch (x) { + case "A" : + return "a"; + case "B" : + return "b"; + case "C" : + return "c"; + case "D" : + return "d"; + + } + } else { + switch (x) { + case "string" : + return "string"; + case "number" : + return "int"; + case "Object" : + return "Object" + x.name; + + } + } +} + +var MultipleBlocks = { + classify: classify$3 +}; + var i = 42; var i2 = 42.5; @@ -119,4 +165,6 @@ exports.l1 = l1; exports.l2 = l2; exports.Truthy = Truthy; exports.TwoObjects = TwoObjects; +exports.Unknown = Unknown; +exports.MultipleBlocks = MultipleBlocks; /* l2 Not a pure module */ diff --git a/jscomp/test/UntaggedVariants.res b/jscomp/test/UntaggedVariants.res index 44f261836d..431f4d3070 100644 --- a/jscomp/test/UntaggedVariants.res +++ b/jscomp/test/UntaggedVariants.res @@ -66,7 +66,7 @@ module Truthy = { } module TwoObjects = { - @unwrapped + @unboxed type t = | @as(null) Null | Object({name: string}) | @as(undefined) Undefined let classify = x => @@ -76,3 +76,34 @@ module TwoObjects = { | Undefined => "undefined" } } + +module Unknown = { + @unboxed + type t<'a> = A | B | Unknown('a) + + let classify = x => + switch x { + | A => "a" + | B => "b" + | Unknown(v) => { + Js.log(x) + "Unknown" + } + } +} + +module MultipleBlocks = { + @unboxed + type t<'a> = A | B | C | D | String(string) | Int(int) | Object({name: string}) + + let classify = x => + switch x { + | A => "a" + | B => "b" + | C => "c" + | D => "d" + | String(_) => "string" + | Int(_) => "int" + | Object({name}) => "Object" ++ name + } +} diff --git a/jscomp/test/variantsMatching.js b/jscomp/test/variantsMatching.js index 4fd4b24d96..3cce9486ac 100644 --- a/jscomp/test/variantsMatching.js +++ b/jscomp/test/variantsMatching.js @@ -182,9 +182,9 @@ function isUndefined(x) { } function plus(x, y) { - if (x === undefined) { + if (typeof x !== "???typ") { return y; - } else if (y === undefined) { + } else if (typeof y !== "???typ") { return x; } else { return x + y | 0; @@ -202,9 +202,9 @@ function isNull(x) { } function plus$1(x, y) { - if (x === null) { + if (typeof x !== "???typ") { return y; - } else if (y === null) { + } else if (typeof y !== "???typ") { return x; } else { return x + y | 0; @@ -228,9 +228,9 @@ function isUndefined$1(x) { } function plus$2(x, y) { - if (x === null || x === undefined) { + if (typeof x !== "???typ") { return y; - } else if (y === null || y === undefined) { + } else if (typeof y !== "???typ") { return x; } else { return x + y | 0; @@ -238,7 +238,7 @@ function plus$2(x, y) { } function kind(x) { - if (x === null || x === undefined) { + if (typeof x !== "???typ") { if (x === null) { return "null"; } else { @@ -278,7 +278,7 @@ function isWhyNot(x) { } function plus$3(x, y) { - if (x === null || typeof x !== "object") { + if (typeof x !== "???typ") { switch (x) { case null : case undefined : @@ -287,13 +287,13 @@ function plus$3(x, y) { break; } - } else if (!(y === null || typeof y !== "object")) { + } else if (typeof y === "???typ") { return { x: x.x + y.x, y: x.y + y.y }; } - if (!(y === null || typeof y !== "object")) { + if (typeof y === "???typ") { return "WhyNotAnotherOne"; } switch (y) { @@ -307,7 +307,7 @@ function plus$3(x, y) { } function kind$1(x) { - if (!(x === null || typeof x !== "object")) { + if (typeof x === "???typ") { return "present"; } switch (x) { From 7b2f666c920619a1a3f242653c55c51494a1c396 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Fri, 31 Mar 2023 09:02:47 +0200 Subject: [PATCH 10/31] Clean up names of types. --- jscomp/core/j.ml | 2 +- jscomp/core/js_dump.ml | 2 +- jscomp/core/js_exp_make.ml | 11 +++++---- jscomp/core/js_exp_make.mli | 4 ++-- jscomp/core/js_stmt_make.ml | 2 +- jscomp/core/js_stmt_make.mli | 2 +- jscomp/core/lam_compile.ml | 37 ++++++++++++++++++++---------- jscomp/frontend/ast_attributes.ml | 2 +- jscomp/frontend/ast_attributes.mli | 2 +- jscomp/ml/lambda.ml | 4 ++-- jscomp/ml/lambda.mli | 4 ++-- jscomp/test/UntaggedVariants.js | 2 +- jscomp/test/variantsMatching.js | 22 +++++++++--------- 13 files changed, 56 insertions(+), 40 deletions(-) diff --git a/jscomp/core/j.ml b/jscomp/core/j.ml index 815779fa2f..6d17f72bc9 100644 --- a/jscomp/core/j.ml +++ b/jscomp/core/j.ml @@ -244,7 +244,7 @@ and case_clause = { comment : string option; } -and string_clause = Lambda.as_value * case_clause +and string_clause = Lambda.literal * case_clause and int_clause = int * case_clause and statement_desc = diff --git a/jscomp/core/js_dump.ml b/jscomp/core/js_dump.ml index ea3d7c239c..620730f9ce 100644 --- a/jscomp/core/js_dump.ml +++ b/jscomp/core/js_dump.ml @@ -1210,7 +1210,7 @@ and statement_desc top cxt f (s : J.statement_desc) : cxt = let cxt = P.paren_group f 1 (fun _ -> expression ~level:0 cxt f e) in P.space f; P.brace_vgroup f 1 (fun _ -> - let pp_as_value f (as_value: Lambda.as_value) = + let pp_as_value f (as_value: Lambda.literal) = let e = E.as_value as_value in ignore @@ expression_desc cxt ~level:0 f e.expression_desc in let cxt = loop_case_clauses cxt f pp_as_value cc in diff --git a/jscomp/core/js_exp_make.ml b/jscomp/core/js_exp_make.ml index 24247c39ae..fc32918c66 100644 --- a/jscomp/core/js_exp_make.ml +++ b/jscomp/core/js_exp_make.ml @@ -766,17 +766,20 @@ let string_equal ?comment (e0 : t) (e1 : t) : t = let is_type_number ?comment (e : t) : t = string_equal ?comment (typeof e) (str "number") -let rec is_not_untagged ~untagged_cases (e:t) : t = +let rec is_not_untagged ~(literal_cases : Lambda.literal list) ~block_cases (e:t) : t = let is_case (c:Lambda.as_untagged) : t = match c with | Lambda.StringType -> { expression_desc = Bin (NotEqEq, typeof e, str "string"); comment=None } | IntType -> { expression_desc = Bin (NotEqEq, typeof e, str "number"); comment=None } | FloatType -> { expression_desc = Bin (NotEqEq, typeof e, str "number"); comment=None } - | Unknown -> { expression_desc = Bin (NotEqEq, typeof e, str "???typ"); comment=None } + | Unknown -> + (* We don't know the type of unknown, so we need to express: + this is not one of the literals *) + { expression_desc = Bin (Eq, typeof e, str "???not_a_literal???"); comment=None } in - match untagged_cases with + match block_cases with | [c] -> is_case c | c1 :: (_::_ as rest) -> - { J.expression_desc = Bin (And, is_case c1, is_not_untagged ~untagged_cases:rest e ); comment = None } + { J.expression_desc = Bin (And, is_case c1, is_not_untagged ~literal_cases ~block_cases:rest e ); comment = None } | [] -> assert false let is_tag ?(has_null_undefined_other=(false, false, false)) (e : t) : t = diff --git a/jscomp/core/js_exp_make.mli b/jscomp/core/js_exp_make.mli index 662e2dbe54..383bfd0847 100644 --- a/jscomp/core/js_exp_make.mli +++ b/jscomp/core/js_exp_make.mli @@ -185,7 +185,7 @@ val assign_by_exp : t -> t -> t -> t val assign : ?comment:string -> t -> t -> t -val as_value : Lambda.as_value -> t +val as_value : Lambda.literal -> t val triple_equal : ?comment:string -> t -> t -> t (* TODO: reduce [triple_equal] use *) @@ -204,7 +204,7 @@ val is_type_number : ?comment:string -> t -> t val is_tag : ?has_null_undefined_other:(bool * bool * bool) -> t -> t -val is_not_untagged : untagged_cases:Lambda.as_untagged list -> t -> t +val is_not_untagged : literal_cases:Lambda.literal list -> block_cases:Lambda.as_untagged list -> t -> t val is_type_string : ?comment:string -> t -> t diff --git a/jscomp/core/js_stmt_make.ml b/jscomp/core/js_stmt_make.ml index 879240a3d4..6ced4f234d 100644 --- a/jscomp/core/js_stmt_make.ml +++ b/jscomp/core/js_stmt_make.ml @@ -129,7 +129,7 @@ let int_switch ?(comment : string option) let string_switch ?(comment : string option) ?(declaration : (J.property * Ident.t) option) ?(default : J.block option) - (e : J.expression) (clauses : (Lambda.as_value * J.case_clause) list) : t = + (e : J.expression) (clauses : (Lambda.literal * J.case_clause) list) : t = match e.expression_desc with | Str {txt} -> ( let continuation = diff --git a/jscomp/core/js_stmt_make.mli b/jscomp/core/js_stmt_make.mli index adda763c25..d0248625c4 100644 --- a/jscomp/core/js_stmt_make.mli +++ b/jscomp/core/js_stmt_make.mli @@ -77,7 +77,7 @@ val string_switch : ?declaration:Lam_compat.let_kind * Ident.t -> ?default:J.block -> J.expression -> - (Lambda.as_value * J.case_clause) list -> + (Lambda.literal * J.case_clause) list -> t val declare_variable : diff --git a/jscomp/core/lam_compile.ml b/jscomp/core/lam_compile.ml index ac4b615448..72deb033dc 100644 --- a/jscomp/core/lam_compile.ml +++ b/jscomp/core/lam_compile.ml @@ -153,18 +153,31 @@ let get_tag_name (sw_names : Lambda.switch_names option) = | _ -> Js_dump_lit.tag ) -let get_untagged_cases (sw_names : Lambda.switch_names option) = +let get_block_cases (sw_names : Lambda.switch_names option) = let res = ref [] in (match sw_names with | None -> res := [] | Some { blocks } -> - Array.iter (function - | {Lambda.cstr_untagged = Some cstr_untagged} -> res := cstr_untagged :: !res - | {Lambda.cstr_untagged = None} -> () - ) blocks + Ext_array.iter blocks (function + | {cstr_untagged = Some cstr_untagged} -> res := cstr_untagged :: !res + | {cstr_untagged = None} -> () + ) ); !res +let get_literal_cases (sw_names : Lambda.switch_names option) = + let res = ref [] in + (match sw_names with + | None -> res := [] + | Some { consts } -> + Ext_array.iter consts (function + | {as_value = Some as_value} -> res := as_value :: !res + | {as_value = None} -> () + ) + ); + !res + + let has_null_undefined_other (sw_names : Lambda.switch_names option) = let (null, undefined, other) = (ref false, ref false, ref false) in (match sw_names with @@ -652,7 +665,7 @@ and compile_switch (switch_arg : Lam.t) (sw : Lam.lambda_switch) in let get_const_name i = get_const_name i sw_names in let get_block i = get_block i sw_names in - let untagged_cases = get_untagged_cases sw_names in + let block_cases = get_block_cases sw_names in let get_block_name i = match get_block i with | None -> None | Some ({cstr_untagged = Some as_untagged} as block) -> @@ -669,22 +682,22 @@ and compile_switch (switch_arg : Lam.t) (sw : Lam.lambda_switch) block @ if sw_consts_full && sw_consts = [] then - compile_cases cxt (if untagged_cases <> [] then e else E.tag ~name:tag_name e) sw_blocks sw_blocks_default get_block_name + compile_cases cxt (if block_cases <> [] then e else E.tag ~name:tag_name e) sw_blocks sw_blocks_default get_block_name else if sw_blocks_full && sw_blocks = [] then compile_cases cxt e sw_consts sw_num_default get_const_name else (* [e] will be used twice *) let dispatch e = let is_tag = - if untagged_cases <> [] - then E.is_not_untagged ~untagged_cases:untagged_cases e + if block_cases <> [] + then E.is_not_untagged ~literal_cases:(get_literal_cases sw_names) ~block_cases e else E.is_tag ~has_null_undefined_other:(has_null_undefined_other sw_names) e in S.if_ is_tag (compile_cases cxt e sw_consts sw_num_default get_const_name) (* default still needed, could simplified*) ~else_: - (compile_cases cxt (if untagged_cases <> [] then e else E.tag ~name:tag_name e) sw_blocks sw_blocks_default + (compile_cases cxt (if block_cases <> [] then e else E.tag ~name:tag_name e) sw_blocks sw_blocks_default get_block_name) in match e.expression_desc with @@ -716,7 +729,7 @@ and compile_string_cases cxt switch_exp table default = let value = function | as_value -> E.as_value as_value in - let add_runtime_type_check (as_value: Lambda.as_value) x = match as_value with + let add_runtime_type_check (as_value: Lambda.literal) x = match as_value with | AsUntagged IntType | AsUntagged StringType | AsUntagged FloatType -> E.typeof x @@ -724,7 +737,7 @@ and compile_string_cases cxt switch_exp table default = (* This should not happen because unknown must be the only non-literal case *) assert false | AsBool _ | AsFloat _ | AsInt _ | AsString _ | AsNull | AsUndefined -> x in - let mk_eq (i : Lambda.as_value option) x j y = match i, j with + let mk_eq (i : Lambda.literal option) x j y = match i, j with | Some as_value, _ -> E.string_equal x (add_runtime_type_check as_value y) | _, Some as_value -> diff --git a/jscomp/frontend/ast_attributes.ml b/jscomp/frontend/ast_attributes.ml index e9b30bde29..a9ebf346e8 100644 --- a/jscomp/frontend/ast_attributes.ml +++ b/jscomp/frontend/ast_attributes.ml @@ -335,7 +335,7 @@ let iter_process_bs_string_or_int_as (attrs : Parsetree.attributes) = !st let process_as_value (attrs : t) = - let st : Lambda.as_value option ref = ref None in + let st : Lambda.literal option ref = ref None in Ext_list.iter attrs (fun (({ txt; loc }, payload) as attr) -> match txt with | "bs.as" | "as" -> diff --git a/jscomp/frontend/ast_attributes.mli b/jscomp/frontend/ast_attributes.mli index 286e0f68be..fe2683d584 100644 --- a/jscomp/frontend/ast_attributes.mli +++ b/jscomp/frontend/ast_attributes.mli @@ -92,7 +92,7 @@ val rs_externals : t -> string list -> bool val process_send_pipe : t -> (Parsetree.core_type * t) option -val process_as_value : t -> Lambda.as_value option +val process_as_value : t -> Lambda.literal option val process_tag_name : t -> string option val process_untagged : t -> bool diff --git a/jscomp/ml/lambda.ml b/jscomp/ml/lambda.ml index ae864aa283..c09c4f8fbc 100644 --- a/jscomp/ml/lambda.ml +++ b/jscomp/ml/lambda.ml @@ -274,10 +274,10 @@ type function_attribute = { type as_untagged = | IntType | StringType | FloatType | Unknown -type as_value = +type literal = | AsString of string | AsInt of int | AsFloat of string | AsBool of bool | AsNull | AsUndefined | AsUntagged of as_untagged -type cstr_name = {name: string; as_value: as_value option} +type cstr_name = {name: string; as_value: literal option} type block = {cstr_name: cstr_name; tag_name: string option; cstr_untagged : as_untagged option} type switch_names = {consts: cstr_name array; blocks: block array} diff --git a/jscomp/ml/lambda.mli b/jscomp/ml/lambda.mli index 755b33915d..f6078cda50 100644 --- a/jscomp/ml/lambda.mli +++ b/jscomp/ml/lambda.mli @@ -274,10 +274,10 @@ type function_attribute = { } type as_untagged = IntType | StringType | FloatType | Unknown -type as_value = +type literal = | AsString of string | AsInt of int | AsFloat of string | AsBool of bool | AsNull | AsUndefined | AsUntagged of as_untagged -type cstr_name = {name:string; as_value: as_value option} +type cstr_name = {name:string; as_value: literal option} type block = {cstr_name: cstr_name; tag_name: string option; cstr_untagged : as_untagged option} type switch_names = {consts: cstr_name array; blocks: block array} diff --git a/jscomp/test/UntaggedVariants.js b/jscomp/test/UntaggedVariants.js index 9d04912799..d3024148e7 100644 --- a/jscomp/test/UntaggedVariants.js +++ b/jscomp/test/UntaggedVariants.js @@ -92,7 +92,7 @@ var TwoObjects = { }; function classify$2(x) { - if (typeof x !== "???typ") { + if (typeof x = "???not_a_literal???") { if (x === "A") { return "a"; } else { diff --git a/jscomp/test/variantsMatching.js b/jscomp/test/variantsMatching.js index 3cce9486ac..0afbff360d 100644 --- a/jscomp/test/variantsMatching.js +++ b/jscomp/test/variantsMatching.js @@ -182,9 +182,9 @@ function isUndefined(x) { } function plus(x, y) { - if (typeof x !== "???typ") { + if (typeof x = "???not_a_literal???") { return y; - } else if (typeof y !== "???typ") { + } else if (typeof y = "???not_a_literal???") { return x; } else { return x + y | 0; @@ -202,9 +202,9 @@ function isNull(x) { } function plus$1(x, y) { - if (typeof x !== "???typ") { + if (typeof x = "???not_a_literal???") { return y; - } else if (typeof y !== "???typ") { + } else if (typeof y = "???not_a_literal???") { return x; } else { return x + y | 0; @@ -228,9 +228,9 @@ function isUndefined$1(x) { } function plus$2(x, y) { - if (typeof x !== "???typ") { + if (typeof x = "???not_a_literal???") { return y; - } else if (typeof y !== "???typ") { + } else if (typeof y = "???not_a_literal???") { return x; } else { return x + y | 0; @@ -238,7 +238,7 @@ function plus$2(x, y) { } function kind(x) { - if (typeof x !== "???typ") { + if (typeof x = "???not_a_literal???") { if (x === null) { return "null"; } else { @@ -278,7 +278,7 @@ function isWhyNot(x) { } function plus$3(x, y) { - if (typeof x !== "???typ") { + if (typeof x = "???not_a_literal???") { switch (x) { case null : case undefined : @@ -287,13 +287,13 @@ function plus$3(x, y) { break; } - } else if (typeof y === "???typ") { + } else if (!(typeof y = "???not_a_literal???")) { return { x: x.x + y.x, y: x.y + y.y }; } - if (typeof y === "???typ") { + if (!(typeof y = "???not_a_literal???")) { return "WhyNotAnotherOne"; } switch (y) { @@ -307,7 +307,7 @@ function plus$3(x, y) { } function kind$1(x) { - if (typeof x === "???typ") { + if (!(typeof x = "???not_a_literal???")) { return "present"; } switch (x) { From 652faef7cb3b013dd4337ccc56b800891879d7e2 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Fri, 31 Mar 2023 09:08:04 +0200 Subject: [PATCH 11/31] Rename: literal --- jscomp/core/js_dump.ml | 12 ++++++------ jscomp/core/js_exp_make.ml | 2 +- jscomp/core/js_exp_make.mli | 2 +- jscomp/core/lam_compile.ml | 24 ++++++++++++------------ jscomp/core/lam_compile_const.ml | 6 +++--- jscomp/core/lam_constant_convert.ml | 4 ++-- jscomp/core/matching_polyfill.ml | 2 +- jscomp/ml/lambda.ml | 2 +- jscomp/ml/lambda.mli | 2 +- 9 files changed, 28 insertions(+), 28 deletions(-) diff --git a/jscomp/core/js_dump.ml b/jscomp/core/js_dump.ml index 620730f9ce..5c30783b5c 100644 --- a/jscomp/core/js_dump.ml +++ b/jscomp/core/js_dump.ml @@ -781,13 +781,13 @@ and expression_desc cxt ~(level : int) f x : cxt = (Js_op.Lit tag_name, (* TAG:xx for inline records *) match Ast_attributes.process_as_value p.attrs with | None -> E.str p.name - | Some as_value -> E.as_value as_value ) + | Some literal -> E.literal literal ) :: tails in expression_desc cxt ~level f (Object objs) | Caml_block (el, _, tag, Blk_constructor p) -> let not_is_cons = p.name <> Literals.cons in - let as_value = Ast_attributes.process_as_value p.attrs in + let literal = Ast_attributes.process_as_value p.attrs in let untagged = Ast_attributes.process_untagged p.attrs in let tag_name = match Ast_attributes.process_tag_name p.attrs with | None -> L.tag @@ -808,9 +808,9 @@ and expression_desc cxt ~(level : int) f x : cxt = if untagged || (not_is_cons = false) && p.num_nonconst = 1 then tails else ( Js_op.Lit tag_name, (* TAG:xx *) - match as_value with + match literal with | None -> E.str p.name - | Some as_value -> E.as_value as_value ) + | Some literal -> E.literal literal ) :: tails in let exp = match objs with @@ -1210,8 +1210,8 @@ and statement_desc top cxt f (s : J.statement_desc) : cxt = let cxt = P.paren_group f 1 (fun _ -> expression ~level:0 cxt f e) in P.space f; P.brace_vgroup f 1 (fun _ -> - let pp_as_value f (as_value: Lambda.literal) = - let e = E.as_value as_value in + let pp_as_value f (literal: Lambda.literal) = + let e = E.literal literal in ignore @@ expression_desc cxt ~level:0 f e.expression_desc in let cxt = loop_case_clauses cxt f pp_as_value cc in match def with diff --git a/jscomp/core/js_exp_make.ml b/jscomp/core/js_exp_make.ml index fc32918c66..eac1a7ec3a 100644 --- a/jscomp/core/js_exp_make.ml +++ b/jscomp/core/js_exp_make.ml @@ -328,7 +328,7 @@ let zero_float_lit : t = let float_mod ?comment e1 e2 : J.expression = { comment; expression_desc = Bin (Mod, e1, e2) } -let as_value = function +let literal = function | Lambda.AsString s -> str s ~delim:DStarJ | AsInt i -> small_int i | AsFloat f -> float f diff --git a/jscomp/core/js_exp_make.mli b/jscomp/core/js_exp_make.mli index 383bfd0847..bbc66906fb 100644 --- a/jscomp/core/js_exp_make.mli +++ b/jscomp/core/js_exp_make.mli @@ -185,7 +185,7 @@ val assign_by_exp : t -> t -> t -> t val assign : ?comment:string -> t -> t -> t -val as_value : Lambda.literal -> t +val literal : Lambda.literal -> t val triple_equal : ?comment:string -> t -> t -> t (* TODO: reduce [triple_equal] use *) diff --git a/jscomp/core/lam_compile.ml b/jscomp/core/lam_compile.ml index 72deb033dc..fef04a402d 100644 --- a/jscomp/core/lam_compile.ml +++ b/jscomp/core/lam_compile.ml @@ -171,8 +171,8 @@ let get_literal_cases (sw_names : Lambda.switch_names option) = | None -> res := [] | Some { consts } -> Ext_array.iter consts (function - | {as_value = Some as_value} -> res := as_value :: !res - | {as_value = None} -> () + | {literal = Some literal} -> res := literal :: !res + | {literal = None} -> () ) ); !res @@ -183,7 +183,7 @@ let has_null_undefined_other (sw_names : Lambda.switch_names option) = (match sw_names with | None -> () | Some { consts; blocks } -> - Ext_array.iter consts (fun x -> match x.as_value with + Ext_array.iter consts (fun x -> match x.literal with | Some AsUndefined -> undefined := true | Some AsNull -> null := true | _ -> other := true); @@ -619,9 +619,9 @@ and compile_general_cases : and use_compile_string_cases table get_name = List.fold_right (fun (i, lam) acc -> match get_name i, acc with - | Some {Lambda.as_value = Some as_value}, Some string_table -> - Some ((as_value, lam) :: string_table) - | Some {name; as_value = None}, Some string_table -> Some ((AsString name, lam) :: string_table) + | Some {Lambda.literal = Some literal}, Some string_table -> + Some ((literal, lam) :: string_table) + | Some {name; literal = None}, Some string_table -> Some ((AsString name, lam) :: string_table) | _, _ -> None ) table (Some []) and compile_cases cxt (switch_exp : E.t) table default get_name = @@ -632,7 +632,7 @@ and compile_cases cxt (switch_exp : E.t) table default get_name = compile_general_cases get_name (fun i -> match get_name i with | None -> E.small_int i - | Some {as_value = Some(AsString s)} -> E.str s + | Some {literal = Some(AsString s)} -> E.str s | Some {name} -> E.str name) (fun _ x _ y -> E.int_equal x y) cxt (fun ?default ?declaration e clauses -> @@ -669,7 +669,7 @@ and compile_switch (switch_arg : Lam.t) (sw : Lam.lambda_switch) let get_block_name i = match get_block i with | None -> None | Some ({cstr_untagged = Some as_untagged} as block) -> - Some {block.cstr_name with as_value = Some (AsUntagged as_untagged)} + Some {block.cstr_name with literal = Some (AsUntagged as_untagged)} | Some ({cstr_untagged = None; cstr_name}) -> Some cstr_name in let tag_name = get_tag_name sw_names in @@ -726,10 +726,10 @@ and compile_switch (switch_arg : Lam.t) (sw : Lam.lambda_switch) | EffectCall _ | Assign _ -> Js_output.make (compile_whole lambda_cxt) and compile_string_cases cxt switch_exp table default = - let value = function - | as_value -> E.as_value as_value + let literal = function + | literal -> E.literal literal in - let add_runtime_type_check (as_value: Lambda.literal) x = match as_value with + let add_runtime_type_check (literal: Lambda.literal) x = match literal with | AsUntagged IntType | AsUntagged StringType | AsUntagged FloatType -> E.typeof x @@ -746,7 +746,7 @@ and compile_string_cases cxt switch_exp table default = in compile_general_cases (fun _ -> None) - value mk_eq + literal mk_eq cxt (fun ?default ?declaration e clauses -> S.string_switch ?default ?declaration e clauses) diff --git a/jscomp/core/lam_compile_const.ml b/jscomp/core/lam_compile_const.ml index 538f209113..f4cfe70ec5 100644 --- a/jscomp/core/lam_compile_const.ml +++ b/jscomp/core/lam_compile_const.ml @@ -47,10 +47,10 @@ and translate (x : Lam_constant.t) : J.expression = | Const_js_false -> E.bool false | Const_js_null -> E.nil | Const_js_undefined -> E.undefined - | Const_int { i; comment = Pt_constructor {cstr_name={name; as_value=None}}} when name <> "[]" -> + | Const_int { i; comment = Pt_constructor {cstr_name={name; literal=None}}} when name <> "[]" -> E.str name - | Const_int { i; comment = Pt_constructor {cstr_name={as_value = Some as_value}}} -> - E.as_value as_value + | Const_int { i; comment = Pt_constructor {cstr_name={literal = Some literal}}} -> + E.literal literal | Const_int { i; comment } -> E.int i ?comment:(Lam_constant.string_of_pointer_info comment) | Const_char i -> Js_of_lam_string.const_char i diff --git a/jscomp/core/lam_constant_convert.ml b/jscomp/core/lam_constant_convert.ml index 7fe9a4ca51..39437c3dd4 100644 --- a/jscomp/core/lam_constant_convert.ml +++ b/jscomp/core/lam_constant_convert.ml @@ -49,11 +49,11 @@ let rec convert_constant (const : Lambda.structured_constant) : Lam_constant.t = | Pt_assertfalse -> Const_int { i = Int32.of_int i; comment = Pt_assertfalse } | Pt_constructor { name; const; non_const; attrs } -> - let as_value = Ast_attributes.process_as_value attrs in + let literal = Ast_attributes.process_as_value attrs in Const_int { i = Int32.of_int i; - comment = Pt_constructor { cstr_name={name; as_value}; const; non_const }; + comment = Pt_constructor { cstr_name={name; literal}; const; non_const }; } | Pt_variant { name } -> if Ext_string.is_valid_hash_number name then diff --git a/jscomp/core/matching_polyfill.ml b/jscomp/core/matching_polyfill.ml index 30772b053b..e9c1a29c6e 100644 --- a/jscomp/core/matching_polyfill.ml +++ b/jscomp/core/matching_polyfill.ml @@ -29,7 +29,7 @@ let names_from_construct_pattern (pat : Typedtree.pattern) = let names_from_type_variant (cstrs : Types.constructor_declaration list) = let get_cstr_name (cstr: Types.constructor_declaration) = { Lambda.name = Ident.name cstr.cd_id; - as_value = Ast_attributes.process_as_value cstr.cd_attributes } in + literal = Ast_attributes.process_as_value cstr.cd_attributes } in let get_tag_name (cstr: Types.constructor_declaration) = Ast_attributes.process_tag_name cstr.cd_attributes in let get_untagged (cstr: Types.constructor_declaration) = diff --git a/jscomp/ml/lambda.ml b/jscomp/ml/lambda.ml index c09c4f8fbc..19a109be41 100644 --- a/jscomp/ml/lambda.ml +++ b/jscomp/ml/lambda.ml @@ -277,7 +277,7 @@ type as_untagged = type literal = | AsString of string | AsInt of int | AsFloat of string | AsBool of bool | AsNull | AsUndefined | AsUntagged of as_untagged -type cstr_name = {name: string; as_value: literal option} +type cstr_name = {name: string; literal: literal option} type block = {cstr_name: cstr_name; tag_name: string option; cstr_untagged : as_untagged option} type switch_names = {consts: cstr_name array; blocks: block array} diff --git a/jscomp/ml/lambda.mli b/jscomp/ml/lambda.mli index f6078cda50..d696808e6b 100644 --- a/jscomp/ml/lambda.mli +++ b/jscomp/ml/lambda.mli @@ -277,7 +277,7 @@ type as_untagged = IntType | StringType | FloatType | Unknown type literal = | AsString of string | AsInt of int | AsFloat of string | AsBool of bool | AsNull | AsUndefined | AsUntagged of as_untagged -type cstr_name = {name:string; as_value: literal option} +type cstr_name = {name:string; literal: literal option} type block = {cstr_name: cstr_name; tag_name: string option; cstr_untagged : as_untagged option} type switch_names = {consts: cstr_name array; blocks: block array} From 85a3dbfeebf13f7724dc71678f3226dfa4eae1ba Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Fri, 31 Mar 2023 09:14:42 +0200 Subject: [PATCH 12/31] More renaming. --- jscomp/core/js_exp_make.ml | 22 +++++++++++----------- jscomp/core/js_exp_make.mli | 2 +- jscomp/core/js_of_lam_variant.ml | 6 +++--- jscomp/core/js_stmt_make.ml | 8 ++++---- jscomp/core/lam_compile.ml | 22 +++++++++++----------- jscomp/frontend/ast_attributes.ml | 12 ++++++------ jscomp/ml/lambda.ml | 8 ++++---- jscomp/ml/lambda.mli | 8 ++++---- 8 files changed, 44 insertions(+), 44 deletions(-) diff --git a/jscomp/core/js_exp_make.ml b/jscomp/core/js_exp_make.ml index eac1a7ec3a..e4bda6f58a 100644 --- a/jscomp/core/js_exp_make.ml +++ b/jscomp/core/js_exp_make.ml @@ -329,16 +329,16 @@ let float_mod ?comment e1 e2 : J.expression = { comment; expression_desc = Bin (Mod, e1, e2) } let literal = function - | Lambda.AsString s -> str s ~delim:DStarJ - | AsInt i -> small_int i - | AsFloat f -> float f - | AsBool b -> bool b - | AsNull -> nil - | AsUndefined -> undefined - | AsUntagged IntType -> str "number" - | AsUntagged FloatType -> str "number" - | AsUntagged StringType -> str "string" - | AsUntagged Unknown -> + | Lambda.String s -> str s ~delim:DStarJ + | Int i -> small_int i + | Float f -> float f + | Bool b -> bool b + | Null -> nil + | Undefined -> undefined + | Untagged IntType -> str "number" + | Untagged FloatType -> str "number" + | Untagged StringType -> str "string" + | Untagged Unknown -> (* TODO: clean up pattern mathing algo whih confuses literal with blocks *) assert false @@ -767,7 +767,7 @@ let is_type_number ?comment (e : t) : t = string_equal ?comment (typeof e) (str "number") let rec is_not_untagged ~(literal_cases : Lambda.literal list) ~block_cases (e:t) : t = - let is_case (c:Lambda.as_untagged) : t = match c with + let is_case (c:Lambda.block_type) : t = match c with | Lambda.StringType -> { expression_desc = Bin (NotEqEq, typeof e, str "string"); comment=None } | IntType -> { expression_desc = Bin (NotEqEq, typeof e, str "number"); comment=None } | FloatType -> { expression_desc = Bin (NotEqEq, typeof e, str "number"); comment=None } diff --git a/jscomp/core/js_exp_make.mli b/jscomp/core/js_exp_make.mli index bbc66906fb..2c2ce8fa0a 100644 --- a/jscomp/core/js_exp_make.mli +++ b/jscomp/core/js_exp_make.mli @@ -204,7 +204,7 @@ val is_type_number : ?comment:string -> t -> t val is_tag : ?has_null_undefined_other:(bool * bool * bool) -> t -> t -val is_not_untagged : literal_cases:Lambda.literal list -> block_cases:Lambda.as_untagged list -> t -> t +val is_not_untagged : literal_cases:Lambda.literal list -> block_cases:Lambda.block_type list -> t -> t val is_type_string : ?comment:string -> t -> t diff --git a/jscomp/core/js_of_lam_variant.ml b/jscomp/core/js_of_lam_variant.ml index 6c3b6fb499..5c8d419550 100644 --- a/jscomp/core/js_of_lam_variant.ml +++ b/jscomp/core/js_of_lam_variant.ml @@ -40,7 +40,7 @@ let eval (arg : J.expression) (dispatches : (string * string) list) : E.t = [ S.string_switch arg (Ext_list.map dispatches (fun (s, r) -> - ( Lambda.AsString s, + ( Lambda.String s, J. { switch_body = [ S.return_stmt (E.str r) ]; @@ -80,7 +80,7 @@ let eval_as_event (arg : J.expression) S.string_switch (E.poly_var_tag_access arg) (Ext_list.map dispatches (fun (s, r) -> - ( Lambda.AsString s, + ( Lambda.String s, J. { switch_body = [ S.return_stmt (E.str r) ]; @@ -108,7 +108,7 @@ let eval_as_int (arg : J.expression) (dispatches : (string * int) list) : E.t = [ S.string_switch arg (Ext_list.map dispatches (fun (s, r) -> - ( Lambda.AsString s, + ( Lambda.String s, J. { switch_body = diff --git a/jscomp/core/js_stmt_make.ml b/jscomp/core/js_stmt_make.ml index 6ced4f234d..2bd81ae472 100644 --- a/jscomp/core/js_stmt_make.ml +++ b/jscomp/core/js_stmt_make.ml @@ -136,11 +136,11 @@ let string_switch ?(comment : string option) match Ext_list.find_opt clauses (fun (switch_case, x) -> match switch_case with - | AsString s -> + | String s -> if s = txt then Some x.switch_body else None - | AsInt _ | AsFloat _| AsBool _ | AsNull - | AsUndefined - | AsUntagged _ -> None) + | Int _ | Float _| Bool _ | Null + | Undefined + | Untagged _ -> None) with | Some case -> case | None -> ( match default with Some x -> x | None -> assert false) diff --git a/jscomp/core/lam_compile.ml b/jscomp/core/lam_compile.ml index fef04a402d..5107b0e33c 100644 --- a/jscomp/core/lam_compile.ml +++ b/jscomp/core/lam_compile.ml @@ -184,8 +184,8 @@ let has_null_undefined_other (sw_names : Lambda.switch_names option) = | None -> () | Some { consts; blocks } -> Ext_array.iter consts (fun x -> match x.literal with - | Some AsUndefined -> undefined := true - | Some AsNull -> null := true + | Some Undefined -> undefined := true + | Some Null -> null := true | _ -> other := true); ); (!null, !undefined, !other) @@ -621,7 +621,7 @@ and use_compile_string_cases table get_name = match get_name i, acc with | Some {Lambda.literal = Some literal}, Some string_table -> Some ((literal, lam) :: string_table) - | Some {name; literal = None}, Some string_table -> Some ((AsString name, lam) :: string_table) + | Some {name; literal = None}, Some string_table -> Some ((String name, lam) :: string_table) | _, _ -> None ) table (Some []) and compile_cases cxt (switch_exp : E.t) table default get_name = @@ -632,7 +632,7 @@ and compile_cases cxt (switch_exp : E.t) table default get_name = compile_general_cases get_name (fun i -> match get_name i with | None -> E.small_int i - | Some {literal = Some(AsString s)} -> E.str s + | Some {literal = Some(String s)} -> E.str s | Some {name} -> E.str name) (fun _ x _ y -> E.int_equal x y) cxt (fun ?default ?declaration e clauses -> @@ -669,7 +669,7 @@ and compile_switch (switch_arg : Lam.t) (sw : Lam.lambda_switch) let get_block_name i = match get_block i with | None -> None | Some ({cstr_untagged = Some as_untagged} as block) -> - Some {block.cstr_name with literal = Some (AsUntagged as_untagged)} + Some {block.cstr_name with literal = Some (Untagged as_untagged)} | Some ({cstr_untagged = None; cstr_name}) -> Some cstr_name in let tag_name = get_tag_name sw_names in @@ -730,13 +730,13 @@ and compile_string_cases cxt switch_exp table default = | literal -> E.literal literal in let add_runtime_type_check (literal: Lambda.literal) x = match literal with - | AsUntagged IntType - | AsUntagged StringType - | AsUntagged FloatType -> E.typeof x - | AsUntagged Unknown -> + | Untagged IntType + | Untagged StringType + | Untagged FloatType -> E.typeof x + | Untagged Unknown -> (* This should not happen because unknown must be the only non-literal case *) assert false - | AsBool _ | AsFloat _ | AsInt _ | AsString _ | AsNull | AsUndefined -> x in + | Bool _ | Float _ | Int _ | String _ | Null | Undefined -> x in let mk_eq (i : Lambda.literal option) x j y = match i, j with | Some as_value, _ -> E.string_equal x (add_runtime_type_check as_value y) @@ -759,7 +759,7 @@ and compile_stringswitch l cases default (lambda_cxt : Lam_compile_context.t) = Be careful: we should avoid multiple evaluation of l, The [gen] can be elimiated when number of [cases] is less than 3 *) - let cases = cases |> List.map (fun (s,l) -> Lambda.AsString s, l) in + let cases = cases |> List.map (fun (s,l) -> Lambda.String s, l) in match compile_lambda { lambda_cxt with continuation = NeedValue Not_tail } l with diff --git a/jscomp/frontend/ast_attributes.ml b/jscomp/frontend/ast_attributes.ml index a9ebf346e8..b61c51842f 100644 --- a/jscomp/frontend/ast_attributes.ml +++ b/jscomp/frontend/ast_attributes.ml @@ -344,30 +344,30 @@ let process_as_value (attrs : t) = | None -> () | Some (s, _dec) -> Bs_ast_invariant.mark_used_bs_attribute attr; - st := Some (AsString s)); + st := Some (String s)); (match Ast_payload.is_single_int payload with | None -> () | Some i -> Bs_ast_invariant.mark_used_bs_attribute attr; - st := Some (AsInt i)); + st := Some (Int i)); (match Ast_payload.is_single_float payload with | None -> () | Some f -> Bs_ast_invariant.mark_used_bs_attribute attr; - st := Some (AsFloat f)); + st := Some (Float f)); (match Ast_payload.is_single_bool payload with | None -> () | Some b -> Bs_ast_invariant.mark_used_bs_attribute attr; - st := Some (AsBool b)); + st := Some (Bool b)); (match Ast_payload.is_single_ident payload with | None -> () | Some Lident "null" -> Bs_ast_invariant.mark_used_bs_attribute attr; - st := Some AsNull + st := Some Null | Some Lident "undefined" -> Bs_ast_invariant.mark_used_bs_attribute attr; - st := Some AsUndefined + st := Some Undefined | Some _ -> Bs_syntaxerr.err loc InvalidVariantAsAnnotation); if !st = None then Bs_syntaxerr.err loc InvalidVariantAsAnnotation ) diff --git a/jscomp/ml/lambda.ml b/jscomp/ml/lambda.ml index 19a109be41..1c5b066401 100644 --- a/jscomp/ml/lambda.ml +++ b/jscomp/ml/lambda.ml @@ -272,13 +272,13 @@ type function_attribute = { async : bool; } -type as_untagged = +type block_type = | IntType | StringType | FloatType | Unknown type literal = - | AsString of string | AsInt of int | AsFloat of string | AsBool of bool | AsNull | AsUndefined - | AsUntagged of as_untagged + | String of string | Int of int | Float of string | Bool of bool | Null | Undefined + | Untagged of block_type type cstr_name = {name: string; literal: literal option} -type block = {cstr_name: cstr_name; tag_name: string option; cstr_untagged : as_untagged option} +type block = {cstr_name: cstr_name; tag_name: string option; cstr_untagged : block_type option} type switch_names = {consts: cstr_name array; blocks: block array} type lambda = diff --git a/jscomp/ml/lambda.mli b/jscomp/ml/lambda.mli index d696808e6b..11038dc2ae 100644 --- a/jscomp/ml/lambda.mli +++ b/jscomp/ml/lambda.mli @@ -273,12 +273,12 @@ type function_attribute = { async : bool; } -type as_untagged = IntType | StringType | FloatType | Unknown +type block_type = IntType | StringType | FloatType | Unknown type literal = - | AsString of string | AsInt of int | AsFloat of string | AsBool of bool | AsNull | AsUndefined - | AsUntagged of as_untagged + | String of string | Int of int | Float of string | Bool of bool | Null | Undefined + | Untagged of block_type type cstr_name = {name:string; literal: literal option} -type block = {cstr_name: cstr_name; tag_name: string option; cstr_untagged : as_untagged option} +type block = {cstr_name: cstr_name; tag_name: string option; cstr_untagged : block_type option} type switch_names = {consts: cstr_name array; blocks: block array} type lambda = From 731d62b2b0d1ce16a0fdb6f7bc230f82d2a61cc1 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Fri, 31 Mar 2023 09:18:13 +0200 Subject: [PATCH 13/31] rename: Block --- jscomp/core/js_exp_make.ml | 8 ++++---- jscomp/core/js_stmt_make.ml | 2 +- jscomp/core/lam_compile.ml | 18 +++++++++--------- jscomp/core/matching_polyfill.ml | 2 +- jscomp/ml/lambda.ml | 4 ++-- jscomp/ml/lambda.mli | 4 ++-- 6 files changed, 19 insertions(+), 19 deletions(-) diff --git a/jscomp/core/js_exp_make.ml b/jscomp/core/js_exp_make.ml index e4bda6f58a..22773dd1b9 100644 --- a/jscomp/core/js_exp_make.ml +++ b/jscomp/core/js_exp_make.ml @@ -335,10 +335,10 @@ let literal = function | Bool b -> bool b | Null -> nil | Undefined -> undefined - | Untagged IntType -> str "number" - | Untagged FloatType -> str "number" - | Untagged StringType -> str "string" - | Untagged Unknown -> + | Block IntType -> str "number" + | Block FloatType -> str "number" + | Block StringType -> str "string" + | Block Unknown -> (* TODO: clean up pattern mathing algo whih confuses literal with blocks *) assert false diff --git a/jscomp/core/js_stmt_make.ml b/jscomp/core/js_stmt_make.ml index 2bd81ae472..0636f33e0b 100644 --- a/jscomp/core/js_stmt_make.ml +++ b/jscomp/core/js_stmt_make.ml @@ -140,7 +140,7 @@ let string_switch ?(comment : string option) if s = txt then Some x.switch_body else None | Int _ | Float _| Bool _ | Null | Undefined - | Untagged _ -> None) + | Block _ -> None) with | Some case -> case | None -> ( match default with Some x -> x | None -> assert false) diff --git a/jscomp/core/lam_compile.ml b/jscomp/core/lam_compile.ml index 5107b0e33c..09b03e5f3f 100644 --- a/jscomp/core/lam_compile.ml +++ b/jscomp/core/lam_compile.ml @@ -159,8 +159,8 @@ let get_block_cases (sw_names : Lambda.switch_names option) = | None -> res := [] | Some { blocks } -> Ext_array.iter blocks (function - | {cstr_untagged = Some cstr_untagged} -> res := cstr_untagged :: !res - | {cstr_untagged = None} -> () + | {block_type = Some block_type} -> res := block_type :: !res + | {block_type = None} -> () ) ); !res @@ -668,9 +668,9 @@ and compile_switch (switch_arg : Lam.t) (sw : Lam.lambda_switch) let block_cases = get_block_cases sw_names in let get_block_name i = match get_block i with | None -> None - | Some ({cstr_untagged = Some as_untagged} as block) -> - Some {block.cstr_name with literal = Some (Untagged as_untagged)} - | Some ({cstr_untagged = None; cstr_name}) -> + | Some ({block_type = Some block_type} as block) -> + Some {block.cstr_name with literal = Some (Block block_type)} + | Some ({block_type = None; cstr_name}) -> Some cstr_name in let tag_name = get_tag_name sw_names in let compile_whole (cxt : Lam_compile_context.t) = @@ -730,10 +730,10 @@ and compile_string_cases cxt switch_exp table default = | literal -> E.literal literal in let add_runtime_type_check (literal: Lambda.literal) x = match literal with - | Untagged IntType - | Untagged StringType - | Untagged FloatType -> E.typeof x - | Untagged Unknown -> + | Block IntType + | Block StringType + | Block FloatType -> E.typeof x + | Block Unknown -> (* This should not happen because unknown must be the only non-literal case *) assert false | Bool _ | Float _ | Int _ | String _ | Null | Undefined -> x in diff --git a/jscomp/core/matching_polyfill.ml b/jscomp/core/matching_polyfill.ml index e9c1a29c6e..9c631aea21 100644 --- a/jscomp/core/matching_polyfill.ml +++ b/jscomp/core/matching_polyfill.ml @@ -42,7 +42,7 @@ let names_from_construct_pattern (pat : Typedtree.pattern) = | true, _ -> None (* TODO: add restrictions here *) in let get_block cstr : Lambda.block = - {cstr_name = get_cstr_name cstr; tag_name = get_tag_name cstr; cstr_untagged = get_untagged cstr} in + {cstr_name = get_cstr_name cstr; tag_name = get_tag_name cstr; block_type = get_untagged cstr} in let consts, blocks = Ext_list.fold_left cstrs ([], []) (fun (consts, blocks) cstr -> if is_nullary_variant cstr.cd_args then diff --git a/jscomp/ml/lambda.ml b/jscomp/ml/lambda.ml index 1c5b066401..f93ab78841 100644 --- a/jscomp/ml/lambda.ml +++ b/jscomp/ml/lambda.ml @@ -276,9 +276,9 @@ type block_type = | IntType | StringType | FloatType | Unknown type literal = | String of string | Int of int | Float of string | Bool of bool | Null | Undefined - | Untagged of block_type + | Block of block_type type cstr_name = {name: string; literal: literal option} -type block = {cstr_name: cstr_name; tag_name: string option; cstr_untagged : block_type option} +type block = {cstr_name: cstr_name; tag_name: string option; block_type : block_type option} type switch_names = {consts: cstr_name array; blocks: block array} type lambda = diff --git a/jscomp/ml/lambda.mli b/jscomp/ml/lambda.mli index 11038dc2ae..c4f73582be 100644 --- a/jscomp/ml/lambda.mli +++ b/jscomp/ml/lambda.mli @@ -276,9 +276,9 @@ type function_attribute = { type block_type = IntType | StringType | FloatType | Unknown type literal = | String of string | Int of int | Float of string | Bool of bool | Null | Undefined - | Untagged of block_type + | Block of block_type type cstr_name = {name:string; literal: literal option} -type block = {cstr_name: cstr_name; tag_name: string option; cstr_untagged : block_type option} +type block = {cstr_name: cstr_name; tag_name: string option; block_type : block_type option} type switch_names = {consts: cstr_name array; blocks: block array} type lambda = From 169be6c3ee5a846ac010c74a8fcb99eccb85b1c4 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Fri, 31 Mar 2023 14:15:08 +0200 Subject: [PATCH 14/31] Handle unknown case. --- jscomp/core/js_exp_make.ml | 16 +++++++++++++--- jscomp/core/js_exp_make.mli | 2 +- jscomp/core/lam_compile.ml | 2 +- jscomp/test/UntaggedVariants.js | 12 ++++-------- jscomp/test/variantsMatching.js | 22 +++++++++++----------- 5 files changed, 30 insertions(+), 24 deletions(-) diff --git a/jscomp/core/js_exp_make.ml b/jscomp/core/js_exp_make.ml index 22773dd1b9..4c1e0929a7 100644 --- a/jscomp/core/js_exp_make.ml +++ b/jscomp/core/js_exp_make.ml @@ -766,7 +766,10 @@ let string_equal ?comment (e0 : t) (e1 : t) : t = let is_type_number ?comment (e : t) : t = string_equal ?comment (typeof e) (str "number") -let rec is_not_untagged ~(literal_cases : Lambda.literal list) ~block_cases (e:t) : t = +let rec is_a_literal_case ~(literal_cases : Lambda.literal list) ~block_cases (e:t) : t = + let is_literal (l:Lambda.literal) : t = + { expression_desc = Bin (EqEqEq, e, literal l); comment=None } + in let is_case (c:Lambda.block_type) : t = match c with | Lambda.StringType -> { expression_desc = Bin (NotEqEq, typeof e, str "string"); comment=None } | IntType -> { expression_desc = Bin (NotEqEq, typeof e, str "number"); comment=None } @@ -774,12 +777,19 @@ let rec is_not_untagged ~(literal_cases : Lambda.literal list) ~block_cases (e:t | Unknown -> (* We don't know the type of unknown, so we need to express: this is not one of the literals *) - { expression_desc = Bin (Eq, typeof e, str "???not_a_literal???"); comment=None } + (match literal_cases with + | [] -> { expression_desc = Bool true; comment=None} + | l1 :: others -> + let eq1 = is_literal l1 in + Ext_list.fold_right others eq1 (fun l eq -> + { J.expression_desc = Bin (Or, is_literal l, eq); comment = None } + ) + ) in match block_cases with | [c] -> is_case c | c1 :: (_::_ as rest) -> - { J.expression_desc = Bin (And, is_case c1, is_not_untagged ~literal_cases ~block_cases:rest e ); comment = None } + { J.expression_desc = Bin (And, is_case c1, is_a_literal_case ~literal_cases ~block_cases:rest e ); comment = None } | [] -> assert false let is_tag ?(has_null_undefined_other=(false, false, false)) (e : t) : t = diff --git a/jscomp/core/js_exp_make.mli b/jscomp/core/js_exp_make.mli index 2c2ce8fa0a..5ab1bcd1a1 100644 --- a/jscomp/core/js_exp_make.mli +++ b/jscomp/core/js_exp_make.mli @@ -204,7 +204,7 @@ val is_type_number : ?comment:string -> t -> t val is_tag : ?has_null_undefined_other:(bool * bool * bool) -> t -> t -val is_not_untagged : literal_cases:Lambda.literal list -> block_cases:Lambda.block_type list -> t -> t +val is_a_literal_case : literal_cases:Lambda.literal list -> block_cases:Lambda.block_type list -> t -> t val is_type_string : ?comment:string -> t -> t diff --git a/jscomp/core/lam_compile.ml b/jscomp/core/lam_compile.ml index 09b03e5f3f..75cb7c890e 100644 --- a/jscomp/core/lam_compile.ml +++ b/jscomp/core/lam_compile.ml @@ -690,7 +690,7 @@ and compile_switch (switch_arg : Lam.t) (sw : Lam.lambda_switch) let dispatch e = let is_tag = if block_cases <> [] - then E.is_not_untagged ~literal_cases:(get_literal_cases sw_names) ~block_cases e + then E.is_a_literal_case ~literal_cases:(get_literal_cases sw_names) ~block_cases e else E.is_tag ~has_null_undefined_other:(has_null_undefined_other sw_names) e in S.if_ is_tag diff --git a/jscomp/test/UntaggedVariants.js b/jscomp/test/UntaggedVariants.js index d3024148e7..f3d2c4a63b 100644 --- a/jscomp/test/UntaggedVariants.js +++ b/jscomp/test/UntaggedVariants.js @@ -92,15 +92,11 @@ var TwoObjects = { }; function classify$2(x) { - if (typeof x = "???not_a_literal???") { - if (x === "A") { - return "a"; - } else { - return "b"; - } + if (x === "A") { + return "a"; + } else { + return "b"; } - console.log(x); - return "Unknown"; } var Unknown = { diff --git a/jscomp/test/variantsMatching.js b/jscomp/test/variantsMatching.js index 0afbff360d..d1522c996a 100644 --- a/jscomp/test/variantsMatching.js +++ b/jscomp/test/variantsMatching.js @@ -182,9 +182,9 @@ function isUndefined(x) { } function plus(x, y) { - if (typeof x = "???not_a_literal???") { + if (x === undefined) { return y; - } else if (typeof y = "???not_a_literal???") { + } else if (y === undefined) { return x; } else { return x + y | 0; @@ -202,9 +202,9 @@ function isNull(x) { } function plus$1(x, y) { - if (typeof x = "???not_a_literal???") { + if (x === null) { return y; - } else if (typeof y = "???not_a_literal???") { + } else if (y === null) { return x; } else { return x + y | 0; @@ -228,9 +228,9 @@ function isUndefined$1(x) { } function plus$2(x, y) { - if (typeof x = "???not_a_literal???") { + if (x === null || x === undefined) { return y; - } else if (typeof y = "???not_a_literal???") { + } else if (y === null || y === undefined) { return x; } else { return x + y | 0; @@ -238,7 +238,7 @@ function plus$2(x, y) { } function kind(x) { - if (typeof x = "???not_a_literal???") { + if (x === null || x === undefined) { if (x === null) { return "null"; } else { @@ -278,7 +278,7 @@ function isWhyNot(x) { } function plus$3(x, y) { - if (typeof x = "???not_a_literal???") { + if (x === null || x === undefined) { switch (x) { case null : case undefined : @@ -287,13 +287,13 @@ function plus$3(x, y) { break; } - } else if (!(typeof y = "???not_a_literal???")) { + } else if (!(y === null || y === undefined)) { return { x: x.x + y.x, y: x.y + y.y }; } - if (!(typeof y = "???not_a_literal???")) { + if (!(y === null || y === undefined)) { return "WhyNotAnotherOne"; } switch (y) { @@ -307,7 +307,7 @@ function plus$3(x, y) { } function kind$1(x) { - if (!(typeof x = "???not_a_literal???")) { + if (!(x === null || x === undefined)) { return "present"; } switch (x) { From dd888b8d2ce27223965fa1771af7e2fd97e4ca3c Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Fri, 31 Mar 2023 14:23:14 +0200 Subject: [PATCH 15/31] Add Object. --- jscomp/core/js_exp_make.ml | 2 ++ jscomp/core/lam_compile.ml | 3 ++- jscomp/core/matching_polyfill.ml | 2 ++ jscomp/ml/lambda.ml | 2 +- jscomp/ml/lambda.mli | 2 +- jscomp/test/UntaggedVariants.js | 6 +++--- 6 files changed, 11 insertions(+), 6 deletions(-) diff --git a/jscomp/core/js_exp_make.ml b/jscomp/core/js_exp_make.ml index 4c1e0929a7..72600cf225 100644 --- a/jscomp/core/js_exp_make.ml +++ b/jscomp/core/js_exp_make.ml @@ -338,6 +338,7 @@ let literal = function | Block IntType -> str "number" | Block FloatType -> str "number" | Block StringType -> str "string" + | Block Object -> str "object" | Block Unknown -> (* TODO: clean up pattern mathing algo whih confuses literal with blocks *) assert false @@ -774,6 +775,7 @@ let rec is_a_literal_case ~(literal_cases : Lambda.literal list) ~block_cases (e | Lambda.StringType -> { expression_desc = Bin (NotEqEq, typeof e, str "string"); comment=None } | IntType -> { expression_desc = Bin (NotEqEq, typeof e, str "number"); comment=None } | FloatType -> { expression_desc = Bin (NotEqEq, typeof e, str "number"); comment=None } + | Object -> { expression_desc = Bin (NotEqEq, typeof e, str "object"); comment=None } | Unknown -> (* We don't know the type of unknown, so we need to express: this is not one of the literals *) diff --git a/jscomp/core/lam_compile.ml b/jscomp/core/lam_compile.ml index 75cb7c890e..75afb5ace8 100644 --- a/jscomp/core/lam_compile.ml +++ b/jscomp/core/lam_compile.ml @@ -732,7 +732,8 @@ and compile_string_cases cxt switch_exp table default = let add_runtime_type_check (literal: Lambda.literal) x = match literal with | Block IntType | Block StringType - | Block FloatType -> E.typeof x + | Block FloatType + | Block Object -> E.typeof x | Block Unknown -> (* This should not happen because unknown must be the only non-literal case *) assert false diff --git a/jscomp/core/matching_polyfill.ml b/jscomp/core/matching_polyfill.ml index 9c631aea21..d3a0718250 100644 --- a/jscomp/core/matching_polyfill.ml +++ b/jscomp/core/matching_polyfill.ml @@ -38,6 +38,8 @@ let names_from_construct_pattern (pat : Typedtree.pattern) = | true, Cstr_tuple [{desc = Tconstr (path, _, _)}] when Path.same path Predef.path_string -> Some Lambda.StringType | true, Cstr_tuple [{desc = Tconstr (path, _, _)}] when Path.same path Predef.path_int -> Some IntType | true, Cstr_tuple [{desc = Tconstr (path, _, _)}] when Path.same path Predef.path_float -> Some FloatType + | true, Cstr_tuple (_ :: _ :: _) -> Some Object + | true, Cstr_record _ -> Some Object | true, Cstr_tuple [{desc = Tvar _ | Tlink ({desc = Tvar _})}] -> Some Unknown | true, _ -> None (* TODO: add restrictions here *) in diff --git a/jscomp/ml/lambda.ml b/jscomp/ml/lambda.ml index f93ab78841..2c31278408 100644 --- a/jscomp/ml/lambda.ml +++ b/jscomp/ml/lambda.ml @@ -273,7 +273,7 @@ type function_attribute = { } type block_type = - | IntType | StringType | FloatType | Unknown + | IntType | StringType | FloatType | Object | Unknown type literal = | String of string | Int of int | Float of string | Bool of bool | Null | Undefined | Block of block_type diff --git a/jscomp/ml/lambda.mli b/jscomp/ml/lambda.mli index c4f73582be..bcece9b672 100644 --- a/jscomp/ml/lambda.mli +++ b/jscomp/ml/lambda.mli @@ -273,7 +273,7 @@ type function_attribute = { async : bool; } -type block_type = IntType | StringType | FloatType | Unknown +type block_type = IntType | StringType | FloatType | Object | Unknown type literal = | String of string | Int of int | Float of string | Bool of bool | Null | Undefined | Block of block_type diff --git a/jscomp/test/UntaggedVariants.js b/jscomp/test/UntaggedVariants.js index f3d2c4a63b..450bf36d6b 100644 --- a/jscomp/test/UntaggedVariants.js +++ b/jscomp/test/UntaggedVariants.js @@ -76,7 +76,7 @@ var Truthy = { }; function classify$1(x) { - if (x === null || x === undefined) { + if (typeof x !== "object") { if (x === null) { return "null"; } else { @@ -104,7 +104,7 @@ var Unknown = { }; function classify$3(x) { - if (typeof x !== "number" && typeof x !== "string") { + if (typeof x !== "object" && typeof x !== "number" && typeof x !== "string") { switch (x) { case "A" : return "a"; @@ -122,7 +122,7 @@ function classify$3(x) { return "string"; case "number" : return "int"; - case "Object" : + case "object" : return "Object" + x.name; } From 51593d15f165ff16b9b07a7d5e11f09f1d00dd55 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Fri, 31 Mar 2023 14:39:27 +0200 Subject: [PATCH 16/31] Add typeof to body of switch. --- jscomp/core/lam_compile.ml | 16 +++++++++------- jscomp/test/UntaggedVariants.js | 2 +- 2 files changed, 10 insertions(+), 8 deletions(-) diff --git a/jscomp/core/lam_compile.ml b/jscomp/core/lam_compile.ml index 75afb5ace8..74b647a72a 100644 --- a/jscomp/core/lam_compile.ml +++ b/jscomp/core/lam_compile.ml @@ -624,10 +624,10 @@ and use_compile_string_cases table get_name = | Some {name; literal = None}, Some string_table -> Some ((String name, lam) :: string_table) | _, _ -> None ) table (Some []) -and compile_cases cxt (switch_exp : E.t) table default get_name = +and compile_cases ?(add_typeof=false) cxt (switch_exp : E.t) table default get_name = match use_compile_string_cases table get_name with | Some string_table -> - compile_string_cases cxt switch_exp string_table default + compile_string_cases ~add_typeof cxt switch_exp string_table default | None -> compile_general_cases get_name (fun i -> match get_name i with @@ -692,12 +692,12 @@ and compile_switch (switch_arg : Lam.t) (sw : Lam.lambda_switch) if block_cases <> [] then E.is_a_literal_case ~literal_cases:(get_literal_cases sw_names) ~block_cases e else - E.is_tag ~has_null_undefined_other:(has_null_undefined_other sw_names) e in + E.is_tag ~has_null_undefined_other:(has_null_undefined_other sw_names) e in S.if_ is_tag (compile_cases cxt e sw_consts sw_num_default get_const_name) (* default still needed, could simplified*) ~else_: - (compile_cases cxt (if block_cases <> [] then e else E.tag ~name:tag_name e) sw_blocks sw_blocks_default + (compile_cases ~add_typeof:(block_cases <> []) cxt (if block_cases <> [] then e else E.tag ~name:tag_name e) sw_blocks sw_blocks_default get_block_name) in match e.expression_desc with @@ -725,7 +725,7 @@ and compile_switch (switch_arg : Lam.t) (sw : Lam.lambda_switch) :: compile_whole { lambda_cxt with continuation = Assign id }) | EffectCall _ | Assign _ -> Js_output.make (compile_whole lambda_cxt) -and compile_string_cases cxt switch_exp table default = +and compile_string_cases ?(add_typeof=false) cxt switch_exp table default = let literal = function | literal -> E.literal literal in @@ -747,10 +747,12 @@ and compile_string_cases cxt switch_exp table default = in compile_general_cases (fun _ -> None) - literal mk_eq + literal + mk_eq cxt (fun ?default ?declaration e clauses -> - S.string_switch ?default ?declaration e clauses) + S.string_switch ?default ?declaration + (if add_typeof then E.typeof e else e) clauses) switch_exp table default (* TODO: optional arguments are not good for high order currying *) diff --git a/jscomp/test/UntaggedVariants.js b/jscomp/test/UntaggedVariants.js index 450bf36d6b..e525418cd5 100644 --- a/jscomp/test/UntaggedVariants.js +++ b/jscomp/test/UntaggedVariants.js @@ -117,7 +117,7 @@ function classify$3(x) { } } else { - switch (x) { + switch (typeof x) { case "string" : return "string"; case "number" : From e0d5501527c753e88ff12094d043924db8b85204 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Fri, 31 Mar 2023 14:42:52 +0200 Subject: [PATCH 17/31] Complete classification of blocks. --- jscomp/core/matching_polyfill.ml | 21 +++++++++++++++------ 1 file changed, 15 insertions(+), 6 deletions(-) diff --git a/jscomp/core/matching_polyfill.ml b/jscomp/core/matching_polyfill.ml index d3a0718250..ed87d22b83 100644 --- a/jscomp/core/matching_polyfill.ml +++ b/jscomp/core/matching_polyfill.ml @@ -35,12 +35,21 @@ let names_from_construct_pattern (pat : Typedtree.pattern) = let get_untagged (cstr: Types.constructor_declaration) = match Ast_attributes.process_untagged cstr.cd_attributes, cstr.cd_args with | false, _ -> None - | true, Cstr_tuple [{desc = Tconstr (path, _, _)}] when Path.same path Predef.path_string -> Some Lambda.StringType - | true, Cstr_tuple [{desc = Tconstr (path, _, _)}] when Path.same path Predef.path_int -> Some IntType - | true, Cstr_tuple [{desc = Tconstr (path, _, _)}] when Path.same path Predef.path_float -> Some FloatType - | true, Cstr_tuple (_ :: _ :: _) -> Some Object - | true, Cstr_record _ -> Some Object - | true, Cstr_tuple [{desc = Tvar _ | Tlink ({desc = Tvar _})}] -> Some Unknown + | true, Cstr_tuple [{desc = Tconstr (path, _, _)}] when Path.same path Predef.path_string -> + Some Lambda.StringType + | true, Cstr_tuple [{desc = Tconstr (path, _, _)}] when Path.same path Predef.path_int -> + Some IntType + | true, Cstr_tuple [{desc = Tconstr (path, _, _)}] when Path.same path Predef.path_float -> + Some FloatType + | true, Cstr_tuple (_ :: _ :: _) -> + (* C(_, _) with at least 2 args is an object *) + Some Object + | true, Cstr_record _ -> + (* inline record is an object *) + Some Object + | true, Cstr_tuple [_] -> + (* Evert other single payload is unknown *) + Some Unknown | true, _ -> None (* TODO: add restrictions here *) in let get_block cstr : Lambda.block = From a327c8e441c979a1817d64c164b700184c4d04d9 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Fri, 31 Mar 2023 18:02:05 +0200 Subject: [PATCH 18/31] Check that the type def is in one of the forms allowed. --- jscomp/core/matching_polyfill.ml | 31 ++++++++++++++++++++++++------- jscomp/frontend/bs_syntaxerr.ml | 3 +++ jscomp/frontend/bs_syntaxerr.mli | 1 + 3 files changed, 28 insertions(+), 7 deletions(-) diff --git a/jscomp/core/matching_polyfill.ml b/jscomp/core/matching_polyfill.ml index ed87d22b83..ecbec21911 100644 --- a/jscomp/core/matching_polyfill.ml +++ b/jscomp/core/matching_polyfill.ml @@ -25,6 +25,23 @@ let is_nullary_variant (x : Types.constructor_arguments) = match x with Types.Cstr_tuple [] -> true | _ -> false +let checkUntaggedVariant ~(blocks : (Location.t * Lambda.block) list) = + let objects = ref 0 in + let unknowns = ref 0 in + let invariant loc = + if !unknowns <> 0 && !objects <> 0 + then Bs_syntaxerr.err loc InvalidUntaggedVariantDefinition; + if !unknowns + !objects > 1 + then Bs_syntaxerr.err loc InvalidUntaggedVariantDefinition in + Ext_list.rev_iter blocks (fun (loc, block) -> match block.block_type with + | Some Unknown -> + incr unknowns; + invariant loc + | Some Object -> + incr objects; + invariant loc + | _ -> ()) + let names_from_construct_pattern (pat : Typedtree.pattern) = let names_from_type_variant (cstrs : Types.constructor_declaration list) = let get_cstr_name (cstr: Types.constructor_declaration) = @@ -48,7 +65,7 @@ let names_from_construct_pattern (pat : Typedtree.pattern) = (* inline record is an object *) Some Object | true, Cstr_tuple [_] -> - (* Evert other single payload is unknown *) + (* Every other single payload is unknown *) Some Unknown | true, _ -> None (* TODO: add restrictions here *) in @@ -58,13 +75,13 @@ let names_from_construct_pattern (pat : Typedtree.pattern) = Ext_list.fold_left cstrs ([], []) (fun (consts, blocks) cstr -> if is_nullary_variant cstr.cd_args then (get_cstr_name cstr :: consts, blocks) - else (consts, get_block cstr :: blocks)) + else (consts, (cstr.cd_loc, get_block cstr) :: blocks)) in - Some - { - Lambda.consts = Ext_array.reverse_of_list consts; - blocks = Ext_array.reverse_of_list blocks; - } + checkUntaggedVariant ~blocks; + let blocks = blocks |> List.map snd in + let consts = Ext_array.reverse_of_list consts in + let blocks = Ext_array.reverse_of_list blocks in + Some { Lambda.consts; blocks } in let rec resolve_path n (path : Path.t) = match Env.find_type path pat.pat_env with diff --git a/jscomp/frontend/bs_syntaxerr.ml b/jscomp/frontend/bs_syntaxerr.ml index 4ba70fcf3d..bab7ea0abc 100644 --- a/jscomp/frontend/bs_syntaxerr.ml +++ b/jscomp/frontend/bs_syntaxerr.ml @@ -53,6 +53,7 @@ type error = | Bs_uncurried_arity_too_large | InvalidVariantAsAnnotation | InvalidVariantTagAnnotation + | InvalidUntaggedVariantDefinition let pp_error fmt err = Format.pp_print_string fmt @@ -103,6 +104,8 @@ let pp_error fmt err = "A variant case annotation @as(...) must be a string or integer, boolean, null, undefined" | InvalidVariantTagAnnotation -> "A variant tag annotation @tag(...) must be a string" + | InvalidUntaggedVariantDefinition -> + "This untagged variant definition is invalid. But since I'm still work in progress I am not able to tell you why." ) type exn += Error of Location.t * error diff --git a/jscomp/frontend/bs_syntaxerr.mli b/jscomp/frontend/bs_syntaxerr.mli index 15c39baee0..bc6101e698 100644 --- a/jscomp/frontend/bs_syntaxerr.mli +++ b/jscomp/frontend/bs_syntaxerr.mli @@ -53,6 +53,7 @@ type error = | Bs_uncurried_arity_too_large | InvalidVariantAsAnnotation | InvalidVariantTagAnnotation + | InvalidUntaggedVariantDefinition val err : Location.t -> error -> 'a From 48cfae8bd9d1d26c8c0d32c83d5344f5f17b698c Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Fri, 31 Mar 2023 18:49:50 +0200 Subject: [PATCH 19/31] Fix well-formedness test no other blocks when there's an unknown --- jscomp/core/matching_polyfill.ml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/jscomp/core/matching_polyfill.ml b/jscomp/core/matching_polyfill.ml index ecbec21911..2c8251a7b5 100644 --- a/jscomp/core/matching_polyfill.ml +++ b/jscomp/core/matching_polyfill.ml @@ -29,10 +29,10 @@ let checkUntaggedVariant ~(blocks : (Location.t * Lambda.block) list) = let objects = ref 0 in let unknowns = ref 0 in let invariant loc = - if !unknowns <> 0 && !objects <> 0 + if !unknowns <> 0 && (List.length blocks <> 1) then Bs_syntaxerr.err loc InvalidUntaggedVariantDefinition; - if !unknowns + !objects > 1 - then Bs_syntaxerr.err loc InvalidUntaggedVariantDefinition in + if !unknowns + !objects > 1 + then Bs_syntaxerr.err loc InvalidUntaggedVariantDefinition in Ext_list.rev_iter blocks (fun (loc, block) -> match block.block_type with | Some Unknown -> incr unknowns; From 979d80c2362be50a0d44d81ea36f80345dab6370 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Sat, 1 Apr 2023 00:04:27 +0200 Subject: [PATCH 20/31] rename --- jscomp/core/js_exp_make.ml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/jscomp/core/js_exp_make.ml b/jscomp/core/js_exp_make.ml index 72600cf225..215747b2c3 100644 --- a/jscomp/core/js_exp_make.ml +++ b/jscomp/core/js_exp_make.ml @@ -771,7 +771,7 @@ let rec is_a_literal_case ~(literal_cases : Lambda.literal list) ~block_cases (e let is_literal (l:Lambda.literal) : t = { expression_desc = Bin (EqEqEq, e, literal l); comment=None } in - let is_case (c:Lambda.block_type) : t = match c with + let is_block_case (c:Lambda.block_type) : t = match c with | Lambda.StringType -> { expression_desc = Bin (NotEqEq, typeof e, str "string"); comment=None } | IntType -> { expression_desc = Bin (NotEqEq, typeof e, str "number"); comment=None } | FloatType -> { expression_desc = Bin (NotEqEq, typeof e, str "number"); comment=None } @@ -789,9 +789,9 @@ let rec is_a_literal_case ~(literal_cases : Lambda.literal list) ~block_cases (e ) in match block_cases with - | [c] -> is_case c + | [c] -> is_block_case c | c1 :: (_::_ as rest) -> - { J.expression_desc = Bin (And, is_case c1, is_a_literal_case ~literal_cases ~block_cases:rest e ); comment = None } + { J.expression_desc = Bin (And, is_block_case c1, is_a_literal_case ~literal_cases ~block_cases:rest e ); comment = None } | [] -> assert false let is_tag ?(has_null_undefined_other=(false, false, false)) (e : t) : t = From 5dfa97fc4d1c9961834bb8d4cfb0e7c396e1eecd Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Sat, 1 Apr 2023 00:07:35 +0200 Subject: [PATCH 21/31] More renaming. --- jscomp/core/js_exp_make.ml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/jscomp/core/js_exp_make.ml b/jscomp/core/js_exp_make.ml index 215747b2c3..61143faf1a 100644 --- a/jscomp/core/js_exp_make.ml +++ b/jscomp/core/js_exp_make.ml @@ -768,7 +768,7 @@ let is_type_number ?comment (e : t) : t = string_equal ?comment (typeof e) (str "number") let rec is_a_literal_case ~(literal_cases : Lambda.literal list) ~block_cases (e:t) : t = - let is_literal (l:Lambda.literal) : t = + let is_literal_case (l:Lambda.literal) : t = { expression_desc = Bin (EqEqEq, e, literal l); comment=None } in let is_block_case (c:Lambda.block_type) : t = match c with @@ -782,9 +782,9 @@ let rec is_a_literal_case ~(literal_cases : Lambda.literal list) ~block_cases (e (match literal_cases with | [] -> { expression_desc = Bool true; comment=None} | l1 :: others -> - let eq1 = is_literal l1 in - Ext_list.fold_right others eq1 (fun l eq -> - { J.expression_desc = Bin (Or, is_literal l, eq); comment = None } + let is_litera_1 = is_literal_case l1 in + Ext_list.fold_right others is_litera_1 (fun literal_n acc -> + { J.expression_desc = Bin (Or, is_literal_case literal_n, acc); comment = None } ) ) in From f1306d1cafaad5b8d3ebe7b1fe185039d311f525 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Sat, 1 Apr 2023 06:20:32 +0200 Subject: [PATCH 22/31] Add specific function compile_untagged_cases --- jscomp/core/lam_compile.ml | 33 +++++++++++++++++++++++---------- 1 file changed, 23 insertions(+), 10 deletions(-) diff --git a/jscomp/core/lam_compile.ml b/jscomp/core/lam_compile.ml index 74b647a72a..1c6a0f1cd5 100644 --- a/jscomp/core/lam_compile.ml +++ b/jscomp/core/lam_compile.ml @@ -616,7 +616,7 @@ and compile_general_cases : [ switch ?default ?declaration switch_exp body ]) -and use_compile_string_cases table get_name = +and use_compile_literal_cases table get_name = List.fold_right (fun (i, lam) acc -> match get_name i, acc with | Some {Lambda.literal = Some literal}, Some string_table -> @@ -624,10 +624,12 @@ and use_compile_string_cases table get_name = | Some {name; literal = None}, Some string_table -> Some ((String name, lam) :: string_table) | _, _ -> None ) table (Some []) -and compile_cases ?(add_typeof=false) cxt (switch_exp : E.t) table default get_name = - match use_compile_string_cases table get_name with +and compile_cases ?(untagged=false) cxt (switch_exp : E.t) table default get_name = + match use_compile_literal_cases table get_name with | Some string_table -> - compile_string_cases ~add_typeof cxt switch_exp string_table default + if untagged + then compile_untagged_cases cxt switch_exp string_table default + else compile_string_cases cxt switch_exp string_table default | None -> compile_general_cases get_name (fun i -> match get_name i with @@ -673,6 +675,7 @@ and compile_switch (switch_arg : Lam.t) (sw : Lam.lambda_switch) | Some ({block_type = None; cstr_name}) -> Some cstr_name in let tag_name = get_tag_name sw_names in + let untagged = block_cases <> [] in let compile_whole (cxt : Lam_compile_context.t) = match compile_lambda { cxt with continuation = NeedValue Not_tail } switch_arg @@ -682,7 +685,7 @@ and compile_switch (switch_arg : Lam.t) (sw : Lam.lambda_switch) block @ if sw_consts_full && sw_consts = [] then - compile_cases cxt (if block_cases <> [] then e else E.tag ~name:tag_name e) sw_blocks sw_blocks_default get_block_name + compile_cases ~untagged cxt (if untagged then e else E.tag ~name:tag_name e) sw_blocks sw_blocks_default get_block_name else if sw_blocks_full && sw_blocks = [] then compile_cases cxt e sw_consts sw_num_default get_const_name else @@ -697,7 +700,7 @@ and compile_switch (switch_arg : Lam.t) (sw : Lam.lambda_switch) (compile_cases cxt e sw_consts sw_num_default get_const_name) (* default still needed, could simplified*) ~else_: - (compile_cases ~add_typeof:(block_cases <> []) cxt (if block_cases <> [] then e else E.tag ~name:tag_name e) sw_blocks sw_blocks_default + (compile_cases ~untagged cxt (if untagged then e else E.tag ~name:tag_name e) sw_blocks sw_blocks_default get_block_name) in match e.expression_desc with @@ -725,7 +728,19 @@ and compile_switch (switch_arg : Lam.t) (sw : Lam.lambda_switch) :: compile_whole { lambda_cxt with continuation = Assign id }) | EffectCall _ | Assign _ -> Js_output.make (compile_whole lambda_cxt) -and compile_string_cases ?(add_typeof=false) cxt switch_exp table default = +and compile_string_cases cxt switch_exp table default = + let literal = function + | literal -> E.literal literal + in + compile_general_cases + (fun _ -> None) + literal + (fun _ x _ y -> E.string_equal x y) + cxt + (fun ?default ?declaration e clauses -> + S.string_switch ?default ?declaration e clauses) + switch_exp table default +and compile_untagged_cases cxt switch_exp table default = let literal = function | literal -> E.literal literal in @@ -752,10 +767,8 @@ and compile_string_cases ?(add_typeof=false) cxt switch_exp table default = cxt (fun ?default ?declaration e clauses -> S.string_switch ?default ?declaration - (if add_typeof then E.typeof e else e) clauses) + (E.typeof e) clauses) switch_exp table default -(* TODO: optional arguments are not good - for high order currying *) and compile_stringswitch l cases default (lambda_cxt : Lam_compile_context.t) = (* TODO might better optimization according to the number of cases From a0f45be4574d15c18be7bb83d5021dc509fc759a Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Sat, 1 Apr 2023 06:22:11 +0200 Subject: [PATCH 23/31] Add example with only blocks. --- jscomp/test/UntaggedVariants.js | 17 +++++++++++++++++ jscomp/test/UntaggedVariants.res | 12 ++++++++++++ 2 files changed, 29 insertions(+) diff --git a/jscomp/test/UntaggedVariants.js b/jscomp/test/UntaggedVariants.js index e525418cd5..f676072428 100644 --- a/jscomp/test/UntaggedVariants.js +++ b/jscomp/test/UntaggedVariants.js @@ -133,6 +133,22 @@ var MultipleBlocks = { classify: classify$3 }; +function classify$4(x) { + switch (typeof x) { + case "string" : + return "string"; + case "number" : + return "int"; + case "object" : + return "Object" + x.name; + + } +} + +var OnlyBlocks = { + classify: classify$4 +}; + var i = 42; var i2 = 42.5; @@ -163,4 +179,5 @@ exports.Truthy = Truthy; exports.TwoObjects = TwoObjects; exports.Unknown = Unknown; exports.MultipleBlocks = MultipleBlocks; +exports.OnlyBlocks = OnlyBlocks; /* l2 Not a pure module */ diff --git a/jscomp/test/UntaggedVariants.res b/jscomp/test/UntaggedVariants.res index 431f4d3070..7411d698b5 100644 --- a/jscomp/test/UntaggedVariants.res +++ b/jscomp/test/UntaggedVariants.res @@ -107,3 +107,15 @@ module MultipleBlocks = { | Object({name}) => "Object" ++ name } } + +module OnlyBlocks = { + @unboxed + type t<'a> = String(string) | Int(int) | Object({name: string}) + + let classify = x => + switch x { + | String(_) => "string" + | Int(_) => "int" + | Object({name}) => "Object" ++ name + } +} From 23c3d7d3d427690d7d992ec4dd322f946695781b Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Sat, 1 Apr 2023 07:51:52 +0200 Subject: [PATCH 24/31] Add support for array types. --- jscomp/core/j.ml | 2 +- jscomp/core/js_dump.ml | 2 +- jscomp/core/js_exp_make.ml | 5 +++++ jscomp/core/js_exp_make.mli | 1 + jscomp/core/js_op.ml | 1 + jscomp/core/js_op_util.ml | 4 ++-- jscomp/core/lam_compile.ml | 25 ++++++++++++++++------- jscomp/core/matching_polyfill.ml | 13 ++++++++++-- jscomp/frontend/ast_attributes.ml | 2 +- jscomp/frontend/ast_utf8_string_interp.ml | 2 +- jscomp/frontend/external_arg_spec.ml | 2 +- jscomp/frontend/external_arg_spec.mli | 2 +- jscomp/ml/lambda.ml | 2 +- jscomp/ml/lambda.mli | 2 +- jscomp/test/UntaggedVariants.js | 20 ++++++++++++++++++ jscomp/test/UntaggedVariants.res | 14 +++++++++++++ 16 files changed, 80 insertions(+), 19 deletions(-) diff --git a/jscomp/core/j.ml b/jscomp/core/j.ml index 6d17f72bc9..35edaf8e71 100644 --- a/jscomp/core/j.ml +++ b/jscomp/core/j.ml @@ -76,7 +76,7 @@ and for_ident = ident and for_direction = Js_op.direction_flag and property_map = (property_name * expression) list and length_object = Js_op.length_object -and delim = External_arg_spec.delim = | DNone | DStarJ | DJson +and delim = External_arg_spec.delim = | DNone | DStarJ | DNoQuotes and expression_desc = | Length of expression * length_object diff --git a/jscomp/core/js_dump.ml b/jscomp/core/js_dump.ml index 5c30783b5c..3e895589fe 100644 --- a/jscomp/core/js_dump.ml +++ b/jscomp/core/js_dump.ml @@ -600,7 +600,7 @@ and expression_desc cxt ~(level : int) f x : cxt = let () = match delim with | DStarJ -> P.string f ("\"" ^ txt ^ "\"") - | DJson -> P.string f txt + | DNoQuotes -> P.string f txt | DNone -> Js_dump_string.pp_string f txt in cxt diff --git a/jscomp/core/js_exp_make.ml b/jscomp/core/js_exp_make.ml index 61143faf1a..8253581cbb 100644 --- a/jscomp/core/js_exp_make.ml +++ b/jscomp/core/js_exp_make.ml @@ -173,6 +173,9 @@ let typeof ?comment (e : t) : t = | Bool _ -> str ?comment L.js_type_boolean | _ -> { expression_desc = Typeof e; comment } +let instanceof ?comment (e0 : t) (e1: t) : t = + { expression_desc = Bin (InstanceOf, e0, e1); comment } + let new_ ?comment e0 args : t = { expression_desc = New (e0, Some args); comment } @@ -338,6 +341,7 @@ let literal = function | Block IntType -> str "number" | Block FloatType -> str "number" | Block StringType -> str "string" + | Block Array -> str "Array" ~delim:DNoQuotes | Block Object -> str "object" | Block Unknown -> (* TODO: clean up pattern mathing algo whih confuses literal with blocks *) @@ -775,6 +779,7 @@ let rec is_a_literal_case ~(literal_cases : Lambda.literal list) ~block_cases (e | Lambda.StringType -> { expression_desc = Bin (NotEqEq, typeof e, str "string"); comment=None } | IntType -> { expression_desc = Bin (NotEqEq, typeof e, str "number"); comment=None } | FloatType -> { expression_desc = Bin (NotEqEq, typeof e, str "number"); comment=None } + | Array -> { expression_desc = Bin (InstanceOf, e, str "object"); comment=None } | Object -> { expression_desc = Bin (NotEqEq, typeof e, str "object"); comment=None } | Unknown -> (* We don't know the type of unknown, so we need to express: diff --git a/jscomp/core/js_exp_make.mli b/jscomp/core/js_exp_make.mli index 5ab1bcd1a1..b77eab3769 100644 --- a/jscomp/core/js_exp_make.mli +++ b/jscomp/core/js_exp_make.mli @@ -211,6 +211,7 @@ val is_type_string : ?comment:string -> t -> t val is_type_object : t -> t val typeof : ?comment:string -> t -> t +val instanceof : ?comment:string -> t -> t -> t val to_int32 : ?comment:string -> t -> t diff --git a/jscomp/core/js_op.ml b/jscomp/core/js_op.ml index 4e40d3eb5b..abf1e7a25d 100644 --- a/jscomp/core/js_op.ml +++ b/jscomp/core/js_op.ml @@ -48,6 +48,7 @@ type binop = | Mul | Div | Mod + | InstanceOf (** note that we don't need raise [Div_by_zero] in ReScript diff --git a/jscomp/core/js_op_util.ml b/jscomp/core/js_op_util.ml index 2bbb3a34f4..6431b16fc8 100644 --- a/jscomp/core/js_op_util.ml +++ b/jscomp/core/js_op_util.ml @@ -34,7 +34,7 @@ let op_prec (op : Js_op.binop) = | Or -> (3, 3, 3) | And -> (4, 4, 4) | EqEqEq | NotEqEq -> (8, 8, 9) - | Gt | Ge | Lt | Le (* | InstanceOf *) -> (9, 9, 10) + | Gt | Ge | Lt | Le | InstanceOf -> (9, 9, 10) | Bor -> (5, 5, 5) | Bxor -> (6, 6, 6) | Band -> (7, 7, 7) @@ -73,7 +73,7 @@ let op_str (op : Js_op.binop) = | Le -> "<=" | Gt -> ">" | Ge -> ">=" -(* | InstanceOf -> "instanceof" *) + | InstanceOf -> "instanceof" let op_int_str (op : Js_op.int_op) = match op with diff --git a/jscomp/core/lam_compile.ml b/jscomp/core/lam_compile.ml index 1c6a0f1cd5..a2bc696dac 100644 --- a/jscomp/core/lam_compile.ml +++ b/jscomp/core/lam_compile.ml @@ -749,25 +749,36 @@ and compile_untagged_cases cxt switch_exp table default = | Block StringType | Block FloatType | Block Object -> E.typeof x + | Block Array -> assert false | Block Unknown -> (* This should not happen because unknown must be the only non-literal case *) assert false | Bool _ | Float _ | Int _ | String _ | Null | Undefined -> x in let mk_eq (i : Lambda.literal option) x j y = match i, j with - | Some as_value, _ -> - E.string_equal x (add_runtime_type_check as_value y) - | _, Some as_value -> - E.string_equal (add_runtime_type_check as_value x) y + | Some literal, _ -> + E.string_equal x (add_runtime_type_check literal y) + | _, Some literal -> + E.string_equal (add_runtime_type_check literal x) y | _ -> E.string_equal x y in + let is_array (l, _) = l = Lambda.Block Array in + let body ?default ?declaration e clauses = + let array_clauses = Ext_list.filter clauses is_array in + match array_clauses with + | [(l, {J.switch_body})] when List.length clauses > 1 -> + let rest = Ext_list.filter clauses (fun c -> not (is_array c)) in + S.if_ (E.instanceof e (E.literal l)) + (switch_body) + ~else_:([S.string_switch ?default ?declaration (E.typeof e) rest]) + | _ :: _ :: _ -> assert false (* at most 1 array case *) + | _ -> + S.string_switch ?default ?declaration (E.typeof e) clauses in compile_general_cases (fun _ -> None) literal mk_eq cxt - (fun ?default ?declaration e clauses -> - S.string_switch ?default ?declaration - (E.typeof e) clauses) + body switch_exp table default and compile_stringswitch l cases default (lambda_cxt : Lam_compile_context.t) = diff --git a/jscomp/core/matching_polyfill.ml b/jscomp/core/matching_polyfill.ml index 2c8251a7b5..37e85fb355 100644 --- a/jscomp/core/matching_polyfill.ml +++ b/jscomp/core/matching_polyfill.ml @@ -26,13 +26,17 @@ let is_nullary_variant (x : Types.constructor_arguments) = match x with Types.Cstr_tuple [] -> true | _ -> false let checkUntaggedVariant ~(blocks : (Location.t * Lambda.block) list) = + let arrays = ref 0 in let objects = ref 0 in let unknowns = ref 0 in let invariant loc = if !unknowns <> 0 && (List.length blocks <> 1) then Bs_syntaxerr.err loc InvalidUntaggedVariantDefinition; - if !unknowns + !objects > 1 - then Bs_syntaxerr.err loc InvalidUntaggedVariantDefinition in + if !unknowns = 1 && !objects + !arrays > 0 + then Bs_syntaxerr.err loc InvalidUntaggedVariantDefinition; + if !objects > 1 || !arrays > 1 + then Bs_syntaxerr.err loc InvalidUntaggedVariantDefinition; + () in Ext_list.rev_iter blocks (fun (loc, block) -> match block.block_type with | Some Unknown -> incr unknowns; @@ -40,6 +44,9 @@ let checkUntaggedVariant ~(blocks : (Location.t * Lambda.block) list) = | Some Object -> incr objects; invariant loc + | Some Array -> + incr arrays; + invariant loc | _ -> ()) let names_from_construct_pattern (pat : Typedtree.pattern) = @@ -58,6 +65,8 @@ let names_from_construct_pattern (pat : Typedtree.pattern) = Some IntType | true, Cstr_tuple [{desc = Tconstr (path, _, _)}] when Path.same path Predef.path_float -> Some FloatType + | true, Cstr_tuple [{desc = Tconstr (path, _, _)}] when Path.same path Predef.path_array -> + Some Array | true, Cstr_tuple (_ :: _ :: _) -> (* C(_, _) with at least 2 args is an object *) Some Object diff --git a/jscomp/frontend/ast_attributes.ml b/jscomp/frontend/ast_attributes.ml index b61c51842f..440b6b54bd 100644 --- a/jscomp/frontend/ast_attributes.ml +++ b/jscomp/frontend/ast_attributes.ml @@ -315,7 +315,7 @@ let iter_process_bs_string_or_int_as (attrs : Parsetree.attributes) = | Some delim -> delim in st := Some (Str (s, delim)); - if delim = DJson then + if delim = DNoQuotes then (* check that it is a valid object literal *) match Classify_function.classify diff --git a/jscomp/frontend/ast_utf8_string_interp.ml b/jscomp/frontend/ast_utf8_string_interp.ml index bd48760007..79f627d102 100644 --- a/jscomp/frontend/ast_utf8_string_interp.ml +++ b/jscomp/frontend/ast_utf8_string_interp.ml @@ -272,7 +272,7 @@ let transform_test s = module Delim = struct let parse_processed = function | None -> Some External_arg_spec.DNone - | Some "json" -> Some DJson + | Some "json" -> Some DNoQuotes | Some "*j" -> Some DStarJ | _ -> None diff --git a/jscomp/frontend/external_arg_spec.ml b/jscomp/frontend/external_arg_spec.ml index 049c44a9e9..0b8474682b 100644 --- a/jscomp/frontend/external_arg_spec.ml +++ b/jscomp/frontend/external_arg_spec.ml @@ -24,7 +24,7 @@ (** type definitions for arguments to a function declared external *) -type delim = | DNone | DStarJ | DJson +type delim = | DNone | DStarJ | DNoQuotes type cst = | Arg_int_lit of int diff --git a/jscomp/frontend/external_arg_spec.mli b/jscomp/frontend/external_arg_spec.mli index b3a21e7791..b08827a228 100644 --- a/jscomp/frontend/external_arg_spec.mli +++ b/jscomp/frontend/external_arg_spec.mli @@ -22,7 +22,7 @@ * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -type delim = | DNone | DStarJ | DJson +type delim = | DNone | DStarJ | DNoQuotes type cst = private | Arg_int_lit of int diff --git a/jscomp/ml/lambda.ml b/jscomp/ml/lambda.ml index 2c31278408..c85dd5bd0f 100644 --- a/jscomp/ml/lambda.ml +++ b/jscomp/ml/lambda.ml @@ -273,7 +273,7 @@ type function_attribute = { } type block_type = - | IntType | StringType | FloatType | Object | Unknown + | IntType | StringType | FloatType | Array | Object | Unknown type literal = | String of string | Int of int | Float of string | Bool of bool | Null | Undefined | Block of block_type diff --git a/jscomp/ml/lambda.mli b/jscomp/ml/lambda.mli index bcece9b672..7077c8f6e4 100644 --- a/jscomp/ml/lambda.mli +++ b/jscomp/ml/lambda.mli @@ -273,7 +273,7 @@ type function_attribute = { async : bool; } -type block_type = IntType | StringType | FloatType | Object | Unknown +type block_type = IntType | StringType | FloatType | Array | Object | Unknown type literal = | String of string | Int of int | Float of string | Bool of bool | Null | Undefined | Block of block_type diff --git a/jscomp/test/UntaggedVariants.js b/jscomp/test/UntaggedVariants.js index f676072428..414afccf0f 100644 --- a/jscomp/test/UntaggedVariants.js +++ b/jscomp/test/UntaggedVariants.js @@ -149,6 +149,25 @@ var OnlyBlocks = { classify: classify$4 }; +function classify$5(x) { + if (x instanceof Array) { + return "array"; + } + switch (typeof x) { + case "string" : + return "string"; + case "number" : + return "int"; + case "object" : + return "Object" + x.name; + + } +} + +var WithArray = { + classify: classify$5 +}; + var i = 42; var i2 = 42.5; @@ -180,4 +199,5 @@ exports.TwoObjects = TwoObjects; exports.Unknown = Unknown; exports.MultipleBlocks = MultipleBlocks; exports.OnlyBlocks = OnlyBlocks; +exports.WithArray = WithArray; /* l2 Not a pure module */ diff --git a/jscomp/test/UntaggedVariants.res b/jscomp/test/UntaggedVariants.res index 7411d698b5..7667a860fd 100644 --- a/jscomp/test/UntaggedVariants.res +++ b/jscomp/test/UntaggedVariants.res @@ -119,3 +119,17 @@ module OnlyBlocks = { | Object({name}) => "Object" ++ name } } + +module WithArray = { + @unboxed + type t<'a> = String(string) | Float(float) | Array(array)| Object({name: string}) + + let classify = x => + switch x { + | String(_) => "string" + | Float(_) => "int" + | Array(_) when true => "array" + | Array(_) => "array" + | Object({name}) => "Object" ++ name + } +} From d152e8b3b911e38c21e68d670bbd85ccd5d09a66 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Sat, 1 Apr 2023 07:56:12 +0200 Subject: [PATCH 25/31] Simplify well-formedness check. --- jscomp/core/matching_polyfill.ml | 2 -- 1 file changed, 2 deletions(-) diff --git a/jscomp/core/matching_polyfill.ml b/jscomp/core/matching_polyfill.ml index 37e85fb355..9be6af2e36 100644 --- a/jscomp/core/matching_polyfill.ml +++ b/jscomp/core/matching_polyfill.ml @@ -32,8 +32,6 @@ let checkUntaggedVariant ~(blocks : (Location.t * Lambda.block) list) = let invariant loc = if !unknowns <> 0 && (List.length blocks <> 1) then Bs_syntaxerr.err loc InvalidUntaggedVariantDefinition; - if !unknowns = 1 && !objects + !arrays > 0 - then Bs_syntaxerr.err loc InvalidUntaggedVariantDefinition; if !objects > 1 || !arrays > 1 then Bs_syntaxerr.err loc InvalidUntaggedVariantDefinition; () in From b2f4f072a27149557ee18a380818b17eec77babd Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Sat, 1 Apr 2023 09:28:01 +0200 Subject: [PATCH 26/31] Add Json example. And add built-in knowledge that Js.Dict.t is an object. --- jscomp/core/js_exp_make.ml | 20 ++++++------ jscomp/core/matching_polyfill.ml | 17 +++++++--- jscomp/test/UntaggedVariants.js | 44 ++++++++++++++++++++++++++ jscomp/test/UntaggedVariants.res | 54 ++++++++++++++++++++++++++++++-- 4 files changed, 117 insertions(+), 18 deletions(-) diff --git a/jscomp/core/js_exp_make.ml b/jscomp/core/js_exp_make.ml index 8253581cbb..80d5a900ce 100644 --- a/jscomp/core/js_exp_make.ml +++ b/jscomp/core/js_exp_make.ml @@ -772,14 +772,12 @@ let is_type_number ?comment (e : t) : t = string_equal ?comment (typeof e) (str "number") let rec is_a_literal_case ~(literal_cases : Lambda.literal list) ~block_cases (e:t) : t = - let is_literal_case (l:Lambda.literal) : t = - { expression_desc = Bin (EqEqEq, e, literal l); comment=None } - in + let is_literal_case (l:Lambda.literal) : t = bin EqEqEq e (literal l) in let is_block_case (c:Lambda.block_type) : t = match c with - | Lambda.StringType -> { expression_desc = Bin (NotEqEq, typeof e, str "string"); comment=None } - | IntType -> { expression_desc = Bin (NotEqEq, typeof e, str "number"); comment=None } - | FloatType -> { expression_desc = Bin (NotEqEq, typeof e, str "number"); comment=None } - | Array -> { expression_desc = Bin (InstanceOf, e, str "object"); comment=None } + | StringType -> bin NotEqEq (typeof e) (str "string") + | IntType -> bin NotEqEq (typeof e) (str "number") + | FloatType -> bin NotEqEq (typeof e) (str "number") + | Array -> not (bin InstanceOf e (str "Array" ~delim:DNoQuotes)) | Object -> { expression_desc = Bin (NotEqEq, typeof e, str "object"); comment=None } | Unknown -> (* We don't know the type of unknown, so we need to express: @@ -787,16 +785,16 @@ let rec is_a_literal_case ~(literal_cases : Lambda.literal list) ~block_cases (e (match literal_cases with | [] -> { expression_desc = Bool true; comment=None} | l1 :: others -> - let is_litera_1 = is_literal_case l1 in - Ext_list.fold_right others is_litera_1 (fun literal_n acc -> - { J.expression_desc = Bin (Or, is_literal_case literal_n, acc); comment = None } + let is_literal_1 = is_literal_case l1 in + Ext_list.fold_right others is_literal_1 (fun literal_n acc -> + bin Or (is_literal_case literal_n) acc ) ) in match block_cases with | [c] -> is_block_case c | c1 :: (_::_ as rest) -> - { J.expression_desc = Bin (And, is_block_case c1, is_a_literal_case ~literal_cases ~block_cases:rest e ); comment = None } + bin And (is_block_case c1) (is_a_literal_case ~literal_cases ~block_cases:rest e) | [] -> assert false let is_tag ?(has_null_undefined_other=(false, false, false)) (e : t) : t = diff --git a/jscomp/core/matching_polyfill.ml b/jscomp/core/matching_polyfill.ml index 9be6af2e36..b7502cb8a1 100644 --- a/jscomp/core/matching_polyfill.ml +++ b/jscomp/core/matching_polyfill.ml @@ -54,26 +54,33 @@ let names_from_construct_pattern (pat : Typedtree.pattern) = literal = Ast_attributes.process_as_value cstr.cd_attributes } in let get_tag_name (cstr: Types.constructor_declaration) = Ast_attributes.process_tag_name cstr.cd_attributes in - let get_untagged (cstr: Types.constructor_declaration) = + let get_untagged (cstr: Types.constructor_declaration) : Lambda.block_type option = match Ast_attributes.process_untagged cstr.cd_attributes, cstr.cd_args with | false, _ -> None | true, Cstr_tuple [{desc = Tconstr (path, _, _)}] when Path.same path Predef.path_string -> - Some Lambda.StringType + Some StringType | true, Cstr_tuple [{desc = Tconstr (path, _, _)}] when Path.same path Predef.path_int -> Some IntType | true, Cstr_tuple [{desc = Tconstr (path, _, _)}] when Path.same path Predef.path_float -> Some FloatType | true, Cstr_tuple [{desc = Tconstr (path, _, _)}] when Path.same path Predef.path_array -> Some Array + | true, Cstr_tuple [{desc = Tconstr (path, _, _)}] when Path. same path Predef.path_string -> + Some StringType + | true, Cstr_tuple [{desc = Tconstr (path, _, _)}] -> + (match Path.name path with + | "Js.Dict.t" + | "Js_dict.t" -> Some Object + | _ -> Some Unknown) | true, Cstr_tuple (_ :: _ :: _) -> (* C(_, _) with at least 2 args is an object *) Some Object - | true, Cstr_record _ -> - (* inline record is an object *) - Some Object | true, Cstr_tuple [_] -> (* Every other single payload is unknown *) Some Unknown + | true, Cstr_record _ -> + (* inline record is an object *) + Some Object | true, _ -> None (* TODO: add restrictions here *) in let get_block cstr : Lambda.block = diff --git a/jscomp/test/UntaggedVariants.js b/jscomp/test/UntaggedVariants.js index 414afccf0f..cdb620b94d 100644 --- a/jscomp/test/UntaggedVariants.js +++ b/jscomp/test/UntaggedVariants.js @@ -168,6 +168,49 @@ var WithArray = { classify: classify$5 }; +function classify$6(x) { + if (!(x instanceof Array) && typeof x !== "object" && typeof x !== "number" && typeof x !== "string") { + switch (x) { + case false : + return "JSONFalse"; + case true : + return "JSONTrue"; + case null : + return "JSONNull"; + + } + } else { + if (x instanceof Array) { + return { + TAG: "JSONArray", + _0: x + }; + } + switch (typeof x) { + case "string" : + return { + TAG: "JSONString", + _0: x + }; + case "number" : + return { + TAG: "JSONNumber", + _0: x + }; + case "object" : + return { + TAG: "JSONObject", + _0: x + }; + + } + } +} + +var Json = { + classify: classify$6 +}; + var i = 42; var i2 = 42.5; @@ -200,4 +243,5 @@ exports.Unknown = Unknown; exports.MultipleBlocks = MultipleBlocks; exports.OnlyBlocks = OnlyBlocks; exports.WithArray = WithArray; +exports.Json = Json; /* l2 Not a pure module */ diff --git a/jscomp/test/UntaggedVariants.res b/jscomp/test/UntaggedVariants.res index 7667a860fd..c0305c0f8f 100644 --- a/jscomp/test/UntaggedVariants.res +++ b/jscomp/test/UntaggedVariants.res @@ -122,14 +122,64 @@ module OnlyBlocks = { module WithArray = { @unboxed - type t<'a> = String(string) | Float(float) | Array(array)| Object({name: string}) + type t<'a> = String(string) | Float(float) | Array(array) | Object({name: string}) let classify = x => switch x { | String(_) => "string" | Float(_) => "int" - | Array(_) when true => "array" + | Array(_) if true => "array" | Array(_) => "array" | Object({name}) => "Object" ++ name } } + +module Json = { + @unboxed + type rec t = + | @as(false) False + | @as(true) True + | @as(null) Null + | String(string) + | Number(float) + | Object(Js.Dict.t) + | Array(array) + + type tagged_t = + | JSONFalse + | JSONTrue + | JSONNull + | JSONString(string) + | JSONNumber(float) + | JSONObject(Js.Dict.t) + | JSONArray(array) + + let classify = (x: t) => + switch x { + | False => JSONFalse + | True => JSONTrue + | Null => JSONNull + | String(s) => JSONString(s) + | Number(n) => JSONNumber(n) + | Object(o) => JSONObject(o) + | Array(a) => JSONArray(a) + } + + /* from js_json.ml +let classify (x : t) : tagged_t = + let ty = Js.typeof x in + if ty = "string" then + JSONString (Obj.magic x) + else if ty = "number" then + JSONNumber (Obj.magic x ) + else if ty = "boolean" then + if (Obj.magic x) = true then JSONTrue + else JSONFalse + else if (Obj.magic x) == Js.null then + JSONNull + else if Js_array2.isArray x then + JSONArray (Obj.magic x) + else + JSONObject (Obj.magic x) + */ +} From 643039c562f82b0aff810434f5f62d1fdbf101fa Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Sat, 1 Apr 2023 11:27:38 +0200 Subject: [PATCH 27/31] Fix instanceof array. --- jscomp/core/lam_compile.ml | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/jscomp/core/lam_compile.ml b/jscomp/core/lam_compile.ml index a2bc696dac..1d33ef9615 100644 --- a/jscomp/core/lam_compile.ml +++ b/jscomp/core/lam_compile.ml @@ -744,21 +744,21 @@ and compile_untagged_cases cxt switch_exp table default = let literal = function | literal -> E.literal literal in - let add_runtime_type_check (literal: Lambda.literal) x = match literal with + let add_runtime_type_check (literal: Lambda.literal) x y = match literal with | Block IntType | Block StringType | Block FloatType - | Block Object -> E.typeof x - | Block Array -> assert false + | Block Object -> E.string_equal (E.typeof y) x + | Block Array -> E.instanceof x y | Block Unknown -> (* This should not happen because unknown must be the only non-literal case *) assert false | Bool _ | Float _ | Int _ | String _ | Null | Undefined -> x in let mk_eq (i : Lambda.literal option) x j y = match i, j with - | Some literal, _ -> - E.string_equal x (add_runtime_type_check literal y) + | Some literal, _ -> (* XX *) + add_runtime_type_check literal x y | _, Some literal -> - E.string_equal (add_runtime_type_check literal x) y + add_runtime_type_check literal y x | _ -> E.string_equal x y in let is_array (l, _) = l = Lambda.Block Array in From 6d96cf45ddf0301bfe477021da89e2b8448c30f7 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Sat, 1 Apr 2023 11:32:17 +0200 Subject: [PATCH 28/31] flip --- jscomp/core/lam_compile.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/jscomp/core/lam_compile.ml b/jscomp/core/lam_compile.ml index 1d33ef9615..be9f189592 100644 --- a/jscomp/core/lam_compile.ml +++ b/jscomp/core/lam_compile.ml @@ -749,7 +749,7 @@ and compile_untagged_cases cxt switch_exp table default = | Block StringType | Block FloatType | Block Object -> E.string_equal (E.typeof y) x - | Block Array -> E.instanceof x y + | Block Array -> E.instanceof y x | Block Unknown -> (* This should not happen because unknown must be the only non-literal case *) assert false From 4d5c1542b55ec322f1c2649d04b7db3246484094 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Sun, 2 Apr 2023 06:34:46 +0200 Subject: [PATCH 29/31] Fix compilation of unknown. --- jscomp/core/js_exp_make.ml | 6 ++++-- jscomp/core/js_exp_make.mli | 2 +- jscomp/core/lam_compile.ml | 12 ++++++------ jscomp/ml/matching.ml | 7 +++---- jscomp/test/UntaggedVariants.js | 33 ++++++++++++++++++++++++++++---- jscomp/test/UntaggedVariants.res | 13 +++++++++++++ jscomp/test/variantsMatching.js | 8 ++++---- 7 files changed, 60 insertions(+), 21 deletions(-) diff --git a/jscomp/core/js_exp_make.ml b/jscomp/core/js_exp_make.ml index 80d5a900ce..bf9fd5b272 100644 --- a/jscomp/core/js_exp_make.ml +++ b/jscomp/core/js_exp_make.ml @@ -783,7 +783,9 @@ let rec is_a_literal_case ~(literal_cases : Lambda.literal list) ~block_cases (e (* We don't know the type of unknown, so we need to express: this is not one of the literals *) (match literal_cases with - | [] -> { expression_desc = Bool true; comment=None} + | [] -> + (* this should not happen *) + assert false | l1 :: others -> let is_literal_1 = is_literal_case l1 in Ext_list.fold_right others is_literal_1 (fun literal_n acc -> @@ -797,7 +799,7 @@ let rec is_a_literal_case ~(literal_cases : Lambda.literal list) ~block_cases (e bin And (is_block_case c1) (is_a_literal_case ~literal_cases ~block_cases:rest e) | [] -> assert false -let is_tag ?(has_null_undefined_other=(false, false, false)) (e : t) : t = +let is_int_tag ?(has_null_undefined_other=(false, false, false)) (e : t) : t = let (has_null, has_undefined, has_other) = has_null_undefined_other in if has_null && (has_undefined = false) && (has_other = false) then (* null *) { expression_desc = Bin (EqEqEq, e, nil); comment=None } diff --git a/jscomp/core/js_exp_make.mli b/jscomp/core/js_exp_make.mli index b77eab3769..d2590e422b 100644 --- a/jscomp/core/js_exp_make.mli +++ b/jscomp/core/js_exp_make.mli @@ -202,7 +202,7 @@ val neq_null_undefined_boolean : ?comment:string -> t -> t -> t val is_type_number : ?comment:string -> t -> t -val is_tag : ?has_null_undefined_other:(bool * bool * bool) -> t -> t +val is_int_tag : ?has_null_undefined_other:(bool * bool * bool) -> t -> t val is_a_literal_case : literal_cases:Lambda.literal list -> block_cases:Lambda.block_type list -> t -> t diff --git a/jscomp/core/lam_compile.ml b/jscomp/core/lam_compile.ml index be9f189592..24943156c0 100644 --- a/jscomp/core/lam_compile.ml +++ b/jscomp/core/lam_compile.ml @@ -172,7 +172,7 @@ let get_literal_cases (sw_names : Lambda.switch_names option) = | Some { consts } -> Ext_array.iter consts (function | {literal = Some literal} -> res := literal :: !res - | {literal = None} -> () + | {name; literal = None} -> res := String name :: !res ) ); !res @@ -691,14 +691,14 @@ and compile_switch (switch_arg : Lam.t) (sw : Lam.lambda_switch) else (* [e] will be used twice *) let dispatch e = - let is_tag = + let is_a_literal_case = if block_cases <> [] - then E.is_a_literal_case ~literal_cases:(get_literal_cases sw_names) ~block_cases e + then + E.is_a_literal_case ~literal_cases:(get_literal_cases sw_names) ~block_cases e else - E.is_tag ~has_null_undefined_other:(has_null_undefined_other sw_names) e in - S.if_ is_tag + E.is_int_tag ~has_null_undefined_other:(has_null_undefined_other sw_names) e in + S.if_ is_a_literal_case (compile_cases cxt e sw_consts sw_num_default get_const_name) - (* default still needed, could simplified*) ~else_: (compile_cases ~untagged cxt (if untagged then e else E.tag ~name:tag_name e) sw_blocks sw_blocks_default get_block_name) diff --git a/jscomp/ml/matching.ml b/jscomp/ml/matching.ml index f271a92d22..cbc6c51b44 100644 --- a/jscomp/ml/matching.ml +++ b/jscomp/ml/matching.ml @@ -1329,11 +1329,10 @@ let make_constr_matching p def ctx = function [] -> fatal_error "Matching.make_constr_matching" | ((arg, _mut) :: argl) -> let cstr = pat_as_constr p in + let untagged = + Ext_list.exists cstr.cstr_attributes (function ({txt}, _) -> txt = "unboxed") in let newargs = - if cstr.cstr_inlined <> None || - Ext_list.exists cstr.cstr_attributes (function - | ({txt="unboxed"}, _) -> true - | _ -> false) then + if cstr.cstr_inlined <> None || (untagged && cstr.cstr_args <> []) then (arg, Alias) :: argl else match cstr.cstr_tag with | Cstr_block _ when diff --git a/jscomp/test/UntaggedVariants.js b/jscomp/test/UntaggedVariants.js index cdb620b94d..79b0d8c375 100644 --- a/jscomp/test/UntaggedVariants.js +++ b/jscomp/test/UntaggedVariants.js @@ -92,11 +92,15 @@ var TwoObjects = { }; function classify$2(x) { - if (x === "A") { - return "a"; - } else { - return "b"; + if (x === "A" || x === "B") { + if (x === "A") { + return "a"; + } else { + return "b"; + } } + console.log(x); + return "Unknown"; } var Unknown = { @@ -211,6 +215,26 @@ var Json = { classify: classify$6 }; +function check(s, y) { + if (s === "B") { + return 42; + } + var x = s[0]; + if (x === "B") { + return 42; + } + var tmp = s[1]; + if (tmp === "B" && x !== y) { + return 41; + } else { + return 42; + } +} + +var TrickyNested = { + check: check +}; + var i = 42; var i2 = 42.5; @@ -244,4 +268,5 @@ exports.MultipleBlocks = MultipleBlocks; exports.OnlyBlocks = OnlyBlocks; exports.WithArray = WithArray; exports.Json = Json; +exports.TrickyNested = TrickyNested; /* l2 Not a pure module */ diff --git a/jscomp/test/UntaggedVariants.res b/jscomp/test/UntaggedVariants.res index c0305c0f8f..4531fb2980 100644 --- a/jscomp/test/UntaggedVariants.res +++ b/jscomp/test/UntaggedVariants.res @@ -183,3 +183,16 @@ let classify (x : t) : tagged_t = JSONObject (Obj.magic x) */ } + +module TrickyNested = { + @unboxed + type rec t = + | A((t, t)) + | B + + let check = (s, y) => + switch s { + | A((A(x), B)) if x !== y => 41 + | _ => 42 + } +} diff --git a/jscomp/test/variantsMatching.js b/jscomp/test/variantsMatching.js index d1522c996a..08883fc123 100644 --- a/jscomp/test/variantsMatching.js +++ b/jscomp/test/variantsMatching.js @@ -278,7 +278,7 @@ function isWhyNot(x) { } function plus$3(x, y) { - if (x === null || x === undefined) { + if (x === undefined || x === null || x === "WhyNotAnotherOne") { switch (x) { case null : case undefined : @@ -287,13 +287,13 @@ function plus$3(x, y) { break; } - } else if (!(y === null || y === undefined)) { + } else if (!(y === undefined || y === null || y === "WhyNotAnotherOne")) { return { x: x.x + y.x, y: x.y + y.y }; } - if (!(y === null || y === undefined)) { + if (!(y === undefined || y === null || y === "WhyNotAnotherOne")) { return "WhyNotAnotherOne"; } switch (y) { @@ -307,7 +307,7 @@ function plus$3(x, y) { } function kind$1(x) { - if (!(x === null || x === undefined)) { + if (!(x === undefined || x === null || x === "WhyNotAnotherOne")) { return "present"; } switch (x) { From fef1973d5477711b7ed997d1c63b7972de7202a4 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Mon, 3 Apr 2023 00:17:36 +0200 Subject: [PATCH 30/31] Add untagged variant support to genType. --- jscomp/gentype/GenTypeCommon.ml | 8 ++++---- jscomp/gentype/TranslateCoreType.ml | 2 +- jscomp/gentype/TranslateTypeDeclarations.ml | 15 ++++++--------- jscomp/gentype/TranslateTypeExprFromTypes.ml | 6 +++--- jscomp/test/variantsMatching.gen.tsx | 12 ++++++++++++ jscomp/test/variantsMatching.res | 8 ++++---- 6 files changed, 30 insertions(+), 21 deletions(-) diff --git a/jscomp/gentype/GenTypeCommon.ml b/jscomp/gentype/GenTypeCommon.ml index ec3431c1a8..1de0238563 100644 --- a/jscomp/gentype/GenTypeCommon.ml +++ b/jscomp/gentype/GenTypeCommon.ml @@ -68,7 +68,7 @@ type type_ = | Promise of type_ | Tuple of type_ list | TypeVar of string - | Variant of variant + | Variant of variant (* ordinary and polymorphic variants *) and fields = field list and argType = {aName: string; aType: type_} @@ -95,7 +95,7 @@ and variant = { inherits: type_ list; noPayloads: case list; payloads: payload list; - polymorphic: bool; + polymorphic: bool; (* If true, this is a polymorphic variant *) unboxed: bool; } @@ -165,8 +165,8 @@ let rec depToResolvedName (dep : dep) = | Internal resolvedName -> resolvedName | Dot (p, s) -> ResolvedName.dot s (p |> depToResolvedName) -let createVariant ~bsStringOrInt ~inherits ~noPayloads ~payloads ~polymorphic = - let unboxed = payloads = [] in +let createVariant ~bsStringOrInt ~inherits ~noPayloads ~payloads ~polymorphic + ~unboxed = Variant {bsStringOrInt; inherits; noPayloads; payloads; polymorphic; unboxed} let ident ?(builtin = true) ?(typeArgs = []) name = diff --git a/jscomp/gentype/TranslateCoreType.ml b/jscomp/gentype/TranslateCoreType.ml index 8563745d3d..d97aff69b4 100644 --- a/jscomp/gentype/TranslateCoreType.ml +++ b/jscomp/gentype/TranslateCoreType.ml @@ -225,7 +225,7 @@ and translateCoreType_ ~config ~typeVarsGen let inherits = inheritsTranslations |> List.map (fun {type_} -> type_) in let type_ = createVariant ~bsStringOrInt:(asString || asInt) ~noPayloads ~payloads - ~inherits ~polymorphic:true + ~inherits ~polymorphic:true ~unboxed:false in let dependencies = (inheritsTranslations diff --git a/jscomp/gentype/TranslateTypeDeclarations.ml b/jscomp/gentype/TranslateTypeDeclarations.ml index 3d662766cf..45f7365d87 100644 --- a/jscomp/gentype/TranslateTypeDeclarations.ml +++ b/jscomp/gentype/TranslateTypeDeclarations.ml @@ -26,9 +26,9 @@ let createCase (label, attributes) = (match attributes |> Annotation.getAttributePayload Annotation.tagIsAs with - | Some (_, IdentPayload (Lident "null")) -> NullLabel - | Some (_, IdentPayload (Lident "undefined")) -> UndefinedLabel - | Some (_, BoolPayload b) -> BoolLabel b + | Some (_, IdentPayload (Lident "null")) -> NullLabel + | Some (_, IdentPayload (Lident "undefined")) -> UndefinedLabel + | Some (_, BoolPayload b) -> BoolLabel b | Some (_, FloatPayload s) -> FloatLabel s | Some (_, IntPayload i) -> IntLabel i | Some (_, StringPayload asLabel) -> StringLabel asLabel @@ -197,7 +197,7 @@ let traslateDeclarationKind ~config ~loc ~outputFileRelative ~resolver else variant.payloads in createVariant ~bsStringOrInt:false ~inherits:variant.inherits - ~noPayloads ~payloads ~polymorphic:true + ~noPayloads ~payloads ~polymorphic:true ~unboxed:false | _ -> translation.type_ in {translation with type_} |> handleGeneralDeclaration @@ -311,11 +311,8 @@ let traslateDeclarationKind ~config ~loc ~outputFileRelative ~resolver }) in let variantTyp = - match (noPayloads, payloads) with - | [], [{t = type_}] when unboxedAnnotation -> type_ - | _ -> - createVariant ~bsStringOrInt:false ~inherits:[] ~noPayloads ~payloads - ~polymorphic:false + createVariant ~bsStringOrInt:false ~inherits:[] ~noPayloads ~payloads + ~polymorphic:false ~unboxed:unboxedAnnotation in let resolvedTypeName = typeName |> TypeEnv.addModulePath ~typeEnv in let exportFromTypeDeclaration = diff --git a/jscomp/gentype/TranslateTypeExprFromTypes.ml b/jscomp/gentype/TranslateTypeExprFromTypes.ml index 4e0edb6bf4..8e11707fc6 100644 --- a/jscomp/gentype/TranslateTypeExprFromTypes.ml +++ b/jscomp/gentype/TranslateTypeExprFromTypes.ml @@ -146,7 +146,7 @@ let translateConstr ~config ~paramsTranslation ~(path : Path.t) ~typeEnv = case 0 "Ok" paramTranslation1.type_; case 1 "Error" paramTranslation2.type_; ] - ~polymorphic:false + ~polymorphic:false ~unboxed:false in { dependencies = @@ -408,7 +408,7 @@ and translateTypeExprFromTypes_ ~config ~typeVarsGen ~typeEnv in let type_ = createVariant ~bsStringOrInt:false ~inherits:[] ~noPayloads ~payloads:[] - ~polymorphic:true + ~polymorphic:true ~unboxed:false in {dependencies = []; type_} | {noPayloads = []; payloads = [(_label, t)]; unknowns = []} -> @@ -439,7 +439,7 @@ and translateTypeExprFromTypes_ ~config ~typeVarsGen ~typeEnv in let type_ = createVariant ~bsStringOrInt:false ~inherits:[] ~noPayloads ~payloads - ~polymorphic:true + ~polymorphic:true ~unboxed:false in let dependencies = payloadTranslations diff --git a/jscomp/test/variantsMatching.gen.tsx b/jscomp/test/variantsMatching.gen.tsx index 705fa23b40..8718551676 100644 --- a/jscomp/test/variantsMatching.gen.tsx +++ b/jscomp/test/variantsMatching.gen.tsx @@ -7,3 +7,15 @@ export type t = "thisIsA" | 42 | null | "D" | 3.14; // tslint:disable-next-line:interface-over-type-literal export type tNU = null | undefined; + +// tslint:disable-next-line:interface-over-type-literal +export type MyUndefined_t = undefined | a; + +// tslint:disable-next-line:interface-over-type-literal +export type MyNull_t = null | a; + +// tslint:disable-next-line:interface-over-type-literal +export type MyNullable_t = null | undefined | a; + +// tslint:disable-next-line:interface-over-type-literal +export type MyNullableExtended_t = null | undefined | "WhyNotAnotherOne" | a; diff --git a/jscomp/test/variantsMatching.res b/jscomp/test/variantsMatching.res index 40ac1b4de5..f8b3efd113 100644 --- a/jscomp/test/variantsMatching.res +++ b/jscomp/test/variantsMatching.res @@ -107,7 +107,7 @@ module CustomizeTags = { } module MyUndefined = { - @unboxed + @genType @unboxed type t<'a> = | @as(undefined) Undefined | Present('a) // Note: 'a must not have undefined as value // There can be only one with payload, with 1 argument, to use unboxed @@ -125,7 +125,7 @@ module MyUndefined = { } module MyNull = { - @unboxed + @genType @unboxed type t<'a> = | @as(null) Null | Present('a) // Note: 'a must not have null as value // There can be only one with payload, with 1 argument, to use unboxed @@ -143,7 +143,7 @@ module MyNull = { } module MyNullable = { - @unboxed + @genType @unboxed type t<'a> = | @as(null) Null | @as(undefined) Undefined @@ -176,7 +176,7 @@ module MyNullable = { } module MyNullableExtended = { - @unboxed + @genType @unboxed type t<'a> = | @as(null) Null | @as(undefined) Undefined From 7781a38d2033a4721e91e14389f2492858ddb648 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Mon, 3 Apr 2023 12:50:33 +0200 Subject: [PATCH 31/31] Update CHANGELOG.md --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 581b0d1b21..6d60dabe66 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -31,6 +31,7 @@ The `make` function of components is generated as an uncurried function. Use best effort to determine the config when formatting a file. https://github.com/rescript-lang/rescript-compiler/pull/5968 https://github.com/rescript-lang/rescript-compiler/pull/6080 https://github.com/rescript-lang/rescript-compiler/pull/6086 https://github.com/rescript-lang/rescript-compiler/pull/6087 - Customization of runtime representation of variants. This is work in progress. E.g. some restrictions on the input. See comments of the form "TODO: put restriction on the variant definitions allowed, to make sure this never happens". https://github.com/rescript-lang/rescript-compiler/pull/6095 +- Introduce untagged variants https://github.com/rescript-lang/rescript-compiler/pull/6103 #### :boom: Breaking Change