├── .gitignore ├── .ocamlformat ├── CHANGES.md ├── CONTRIBUTING.md ├── LICENSE.md ├── Makefile ├── base_for_tests ├── README.org └── src │ ├── base_for_tests.ml │ ├── dune │ ├── test_binary_searchable.ml │ ├── test_binary_searchable.mli │ ├── test_binary_searchable_intf.ml │ ├── test_blit.ml │ ├── test_blit.mli │ └── test_blit_intf.ml ├── command └── src │ ├── command.ml │ ├── command.mli │ ├── command_intf.ml │ ├── dune │ ├── env_var.ml │ ├── env_var.mli │ ├── import.ml │ ├── shape.ml │ └── shape.mli ├── core.opam ├── core ├── COPYRIGHT.txt ├── INRIA-DISCLAIMER.txt ├── MLton-license.txt ├── README.md ├── THIRD-PARTY.txt ├── bench-bin │ ├── array_iter.ml │ ├── array_queue.ml │ ├── bench_hashtbl.ml │ ├── bench_map.ml │ ├── core_stack.ml │ ├── core_string_search_pattern.ml │ ├── core_string_search_pattern.mli │ ├── dequeue.ml │ ├── dune │ ├── hashtbl_bench.ml │ ├── hashtbl_bench.mli │ ├── immediate_bench.ml │ ├── ordering_container.ml │ ├── string_escaping.ml │ └── time_to_string.ml ├── replace_caml_modify_for_testing │ ├── dune │ ├── replace_caml_modify_for_testing.ml │ ├── replace_caml_modify_for_testing.mli │ └── replace_caml_modify_for_testing_stub.c ├── src │ ├── arg.ml │ ├── arg.mli │ ├── array.ml │ ├── array.mli │ ├── array_stubs.c │ ├── atomic.ml │ ├── atomic.mli │ ├── bag.ml │ ├── bag.mli │ ├── bag_intf.ml │ ├── bigbuffer.ml │ ├── bigbuffer.mli │ ├── bigbuffer_internal.ml │ ├── bigbuffer_internal.mli │ ├── bigstring.ml │ ├── bigstring.mli │ ├── bigstring_stubs.c │ ├── bigsubstring.ml │ ├── bigsubstring.mli │ ├── binable.ml │ ├── binable.mli │ ├── binable0.ml │ ├── binable0.mli │ ├── binable_intf.ml │ ├── binary_searchable.ml │ ├── binary_searchable.mli │ ├── binary_searchable_intf.ml │ ├── blang.ml │ ├── blang.mli │ ├── blit.ml │ ├── blit.mli │ ├── blit_intf.ml │ ├── bool.ml │ ├── bool.mli │ ├── bounded_index.ml │ ├── bounded_index.mli │ ├── bounded_index_intf.ml │ ├── byte_units.ml │ ├── byte_units.mli │ ├── byte_units0.ml │ ├── byte_units0.mli │ ├── bytes.ml │ ├── bytes.mli │ ├── char.ml │ ├── char.mli │ ├── command_internal.ml │ ├── command_shape.ml │ ├── command_shape.mli │ ├── comparable.ml │ ├── comparable.mli │ ├── comparable_intf.ml │ ├── comparator.ml │ ├── comparator.mli │ ├── comparator_intf.ml │ ├── container.ml │ ├── container.mli │ ├── container_intf.ml │ ├── core.ml │ ├── core_bigstring.h │ ├── core_bin_prot.ml │ ├── core_bin_prot.mli │ ├── core_pervasives.ml │ ├── core_pervasives.mli │ ├── core_sys.ml │ ├── core_sys.mli │ ├── date.ml │ ├── date.mli │ ├── date0.ml │ ├── date0.mli │ ├── date0_intf.ml │ ├── date_cache.ml │ ├── date_cache.mli │ ├── date_cache_intf.ml │ ├── date_intf.ml │ ├── day_of_week.ml │ ├── day_of_week.mli │ ├── day_of_week_intf.ml │ ├── debug.ml │ ├── debug.mli │ ├── deprecate_pipe_bang.ml │ ├── deprecate_pipe_bang.mli │ ├── deque.ml │ ├── deque.mli │ ├── deriving_hash.ml │ ├── deriving_hash.mli │ ├── deriving_hash_intf.ml │ ├── digit_string_helpers.ml │ ├── digit_string_helpers.mli │ ├── doubly_linked.ml │ ├── doubly_linked.mli │ ├── doubly_linked_intf.ml │ ├── dune │ ├── either.ml │ ├── either.mli │ ├── error.ml │ ├── error.mli │ ├── fdeque.ml │ ├── fdeque.mli │ ├── filename.ml │ ├── filename.mli │ ├── float.ml │ ├── float.mli │ ├── float_with_finite_only_serialization.ml │ ├── float_with_finite_only_serialization.mli │ ├── fn.ml │ ├── fn.mli │ ├── fqueue.ml │ ├── fqueue.mli │ ├── gc.ml │ ├── gc.mli │ ├── gc_stubs.c │ ├── hash_queue.ml │ ├── hash_queue.mli │ ├── hash_queue_intf.ml │ ├── hash_set.ml │ ├── hash_set.mli │ ├── hash_set_intf.ml │ ├── hashable.ml │ ├── hashable.mli │ ├── hashable_intf.ml │ ├── hashtbl.ml │ ├── hashtbl.mli │ ├── hashtbl_intf.ml │ ├── hexdump.ml │ ├── hexdump.mli │ ├── hexdump_intf.ml │ ├── host_and_port.ml │ ├── host_and_port.mli │ ├── iarray.ml │ ├── iarray.mli │ ├── identifiable.ml │ ├── identifiable.mli │ ├── identifiable_intf.ml │ ├── immediate_option.ml │ ├── immediate_option.mli │ ├── immediate_option_intf.ml │ ├── import.ml │ ├── index.mld │ ├── indexed_container.ml │ ├── indexed_container.mli │ ├── indexed_container_intf.ml │ ├── info.ml │ ├── info.mli │ ├── info_intf.ml │ ├── int.ml │ ├── int.mli │ ├── int32.ml │ ├── int32.mli │ ├── int63.ml │ ├── int63.mli │ ├── int64.ml │ ├── int64.mli │ ├── int_intf.ml │ ├── interfaces.ml │ ├── lazy.ml │ ├── lazy.mli │ ├── linked_queue.ml │ ├── linked_queue.mli │ ├── list.ml │ ├── list.mli │ ├── list0.ml │ ├── list0.mli │ ├── make_stable.ml │ ├── make_stable.mli │ ├── make_substring.ml │ ├── make_substring.mli │ ├── make_substring_intf.ml │ ├── map.ml │ ├── map.mli │ ├── map_intf.ml │ ├── maybe_bound.ml │ ├── maybe_bound.mli │ ├── md5.ml │ ├── md5.mli │ ├── md5_stubs.c │ ├── memo.ml │ ├── memo.mli │ ├── modes.ml │ ├── modes.mli │ ├── month.ml │ ├── month.mli │ ├── month_intf.ml │ ├── nativeint.ml │ ├── nativeint.mli │ ├── never_returns.ml │ ├── never_returns.mli │ ├── no_polymorphic_compare.ml │ ├── no_polymorphic_compare.mli │ ├── nothing.ml │ ├── nothing.mli │ ├── ofday_float.ml │ ├── ofday_float.mli │ ├── ofday_helpers.ml │ ├── ofday_helpers.mli │ ├── ofday_intf.ml │ ├── ofday_ns.ml │ ├── ofday_ns.mli │ ├── only_in_test.ml │ ├── only_in_test.mli │ ├── option.ml │ ├── option.mli │ ├── option_array.ml │ ├── option_array.mli │ ├── optional_syntax.ml │ ├── optional_syntax.mli │ ├── optional_syntax_intf.ml │ ├── or_error.ml │ ├── or_error.mli │ ├── ordered_collection_common.ml │ ├── ordered_collection_common.mli │ ├── ordering.ml │ ├── ordering.mli │ ├── percent.ml │ ├── percent.mli │ ├── perms.ml │ ├── perms.mli │ ├── pid.ml │ ├── pid.mli │ ├── portable_lazy.ml │ ├── portable_lazy.mli │ ├── printexc.ml │ ├── printexc.mli │ ├── printf.ml │ ├── printf.mli │ ├── queue.ml │ ├── queue.mli │ ├── quickcheck.ml │ ├── quickcheck.mli │ ├── quickcheck_intf.ml │ ├── quickcheckable.ml │ ├── quickcheckable.mli │ ├── quickcheckable_intf.ml │ ├── ref.ml │ ├── ref.mli │ ├── result.ml │ ├── result.mli │ ├── robustly_comparable.ml │ ├── runtime.js │ ├── runtime.wat │ ├── sequence.ml │ ├── sequence.mli │ ├── set.ml │ ├── set.mli │ ├── set_intf.ml │ ├── set_once.ml │ ├── set_once.mli │ ├── sexp.ml │ ├── sexp.mli │ ├── sexpable.ml │ ├── sexpable.mli │ ├── sign.ml │ ├── sign.mli │ ├── sign_or_nan.ml │ ├── sign_or_nan.mli │ ├── signal.ml │ ├── signal.mli │ ├── source_code_position.ml │ ├── source_code_position.mli │ ├── source_code_position0.ml │ ├── source_code_position0.mli │ ├── span_float.ml │ ├── span_float.mli │ ├── span_helpers.ml │ ├── span_helpers.mli │ ├── span_intf.ml │ ├── span_ns.ml │ ├── span_ns.mli │ ├── stable.ml │ ├── stable_comparable.ml │ ├── stable_int63able.ml │ ├── stable_internal.ml │ ├── stable_module_types.ml │ ├── stable_unit_test.ml │ ├── stable_unit_test.mli │ ├── stable_unit_test_intf.ml │ ├── stack.ml │ ├── stack.mli │ ├── std_internal.ml │ ├── strftime.js │ ├── string.ml │ ├── string.mli │ ├── string_id.ml │ ├── string_id.mli │ ├── string_id_intf.ml │ ├── substring.ml │ ├── substring.mli │ ├── substring_intf.ml │ ├── t.ml │ ├── temporal-polyfill │ │ ├── LICENSE │ │ ├── dune │ │ ├── readme.md │ │ └── temporal-polyfill.js │ ├── time.ml │ ├── time.mli │ ├── time0_intf.ml │ ├── time_float.ml │ ├── time_float.mli │ ├── time_float0.ml │ ├── time_float0.mli │ ├── time_intf.ml │ ├── time_ns.ml │ ├── time_ns.mli │ ├── time_ns_alternate_sexp.ml │ ├── time_ns_alternate_sexp.mli │ ├── time_ns_intf.ml │ ├── timezone.ml │ ├── timezone.mli │ ├── timezone_intf.ml │ ├── timezone_js_loader.ml │ ├── timezone_js_loader.mli │ ├── timezone_js_loader_stubs.c │ ├── timezone_js_loader_stubs.js │ ├── timezone_js_loader_stubs.wasm.js │ ├── timezone_js_loader_stubs.wat │ ├── timezone_runtime.js │ ├── timezone_types.ml │ ├── tuple.ml │ ├── tuple.mli │ ├── tuple_intf.ml │ ├── type_equal.ml │ ├── type_equal.mli │ ├── type_equal_intf.ml │ ├── type_immediacy.ml │ ├── type_immediacy.mli │ ├── uchar.ml │ ├── uchar.mli │ ├── uniform_array.ml │ ├── uniform_array.mli │ ├── union_find.ml │ ├── union_find.mli │ ├── unique_id.ml │ ├── unique_id.mli │ ├── unique_id_intf.ml │ ├── unit.ml │ ├── unit.mli │ ├── unit_of_time.ml │ ├── unit_of_time.mli │ ├── validated.ml │ ├── validated.mli │ ├── validated_intf.ml │ ├── zone.ml │ ├── zone.mli │ └── zone_intf.ml ├── strftime.js-licence.txt ├── test-bin │ ├── bin │ │ ├── dune │ │ ├── just_raise.ml │ │ └── just_raise.mli │ └── src │ │ ├── core_uncaught_exception_test.ml │ │ ├── dune │ │ ├── test_uncaught_exception.ml │ │ └── test_uncaught_exception.mli ├── test │ ├── binable_and_sexpable_unit_tests.ml │ ├── binable_and_sexpable_unit_tests.mli │ ├── bool_tests.ml │ ├── bool_tests.mli │ ├── core_gc_unit_tests.ml │ ├── core_gc_unit_tests.mli │ ├── core_int63_unit_tests.ml │ ├── core_int63_unit_tests.mli │ ├── core_list_unit_tests.ml │ ├── core_list_unit_tests.mli │ ├── core_map_unit_tests.ml │ ├── core_map_unit_tests.mli │ ├── core_set_unit_tests.ml │ ├── core_set_unit_tests.mli │ ├── core_string_unit_tests.ml │ ├── core_string_unit_tests.mli │ ├── core_test.ml │ ├── deprecation.mlt │ ├── digit_string_helpers_tests.ml │ ├── digit_string_helpers_tests.mli │ ├── dune │ ├── export_base_buffer.mlt │ ├── fn_for_testing.ml │ ├── fn_for_testing.mli │ ├── fqueue_tests.ml │ ├── fqueue_tests.mli │ ├── hashtbl_unit_tests.ml │ ├── hashtbl_unit_tests.mli │ ├── hashtbl_unit_tests_intf.ml │ ├── helpers │ │ ├── blit_helpers.ml │ │ ├── blit_helpers.mli │ │ ├── blit_helpers_intf.ml │ │ ├── core_test_helpers.ml │ │ ├── dune │ │ ├── test_container_with_local.ml │ │ ├── test_container_with_local.mli │ │ └── test_container_with_local_intf.ml │ ├── import.ml │ ├── info_unit_tests.ml │ ├── info_unit_tests.mli │ ├── linked_queue_tests.ml │ ├── linked_queue_tests.mli │ ├── memo_argument.mlt │ ├── or_error_unit_tests.ml │ ├── or_error_unit_tests.mli │ ├── permissions.mlt │ ├── quickcheck_unit_tests.ml │ ├── quickcheck_unit_tests.mli │ ├── sample_time_zone_file │ ├── std_unit_tests.ml │ ├── std_unit_tests.mli │ ├── test-validated.mlt │ ├── test_am_running_test.ml │ ├── test_am_running_test.mli │ ├── test_am_running_test.mlt │ ├── test_array.ml │ ├── test_array.mli │ ├── test_array_local.mlt │ ├── test_avltree.ml │ ├── test_avltree.mli │ ├── test_bag.ml │ ├── test_bag.mli │ ├── test_bigstring.ml │ ├── test_bigstring.mli │ ├── test_bigstring_safe_accessors.ml │ ├── test_bigstring_safe_accessors.mli │ ├── test_bigstring_unsafe_accessors.ml │ ├── test_bigstring_unsafe_accessors.mli │ ├── test_bigstring_unsafe_destroy.ml │ ├── test_bigstring_unsafe_destroy.mli │ ├── test_binable.ml │ ├── test_binable.mli │ ├── test_blang.ml │ ├── test_blang.mli │ ├── test_bounded_index.ml │ ├── test_bounded_index.mli │ ├── test_byte_units.ml │ ├── test_byte_units.mli │ ├── test_char.ml │ ├── test_char.mli │ ├── test_command_shape.ml │ ├── test_command_shape.mli │ ├── test_container_module_types.ml │ ├── test_container_module_types.mli │ ├── test_date.ml │ ├── test_date.mli │ ├── test_day_of_week.ml │ ├── test_day_of_week.mli │ ├── test_deque.ml │ ├── test_deque.mli │ ├── test_deriving_hash.ml │ ├── test_deriving_hash.mli │ ├── test_deriving_structures.ml │ ├── test_deriving_structures.mli │ ├── test_doubly_linked.ml │ ├── test_doubly_linked.mli │ ├── test_doubly_linked_bisimulation.ml │ ├── test_doubly_linked_bisimulation.mli │ ├── test_error.ml │ ├── test_error.mli │ ├── test_fdeque.ml │ ├── test_fdeque.mli │ ├── test_float.ml │ ├── test_float.mli │ ├── test_hash_queue.ml │ ├── test_hash_queue.mli │ ├── test_hexdump.ml │ ├── test_hexdump.mli │ ├── test_host_and_port.ml │ ├── test_host_and_port.mli │ ├── test_iarray.ml │ ├── test_iarray.mli │ ├── test_identifiable.ml │ ├── test_identifiable.mli │ ├── test_int63.ml │ ├── test_int63.mli │ ├── test_list.ml │ ├── test_list.mli │ ├── test_map.ml │ ├── test_map.mli │ ├── test_map.mlt │ ├── test_map_interface.ml │ ├── test_map_interface.mli │ ├── test_maybe_bound.ml │ ├── test_maybe_bound.mli │ ├── test_md5.ml │ ├── test_md5.mli │ ├── test_memo.ml │ ├── test_memo.mli │ ├── test_modes.ml │ ├── test_modes.mli │ ├── test_month.ml │ ├── test_month.mli │ ├── test_not_found.mlt │ ├── test_not_found2.mlt │ ├── test_nothing.ml │ ├── test_nothing.mli │ ├── test_option.ml │ ├── test_option.mli │ ├── test_or_error.ml │ ├── test_or_error.mli │ ├── test_percent.ml │ ├── test_percent.mli │ ├── test_phys_same.ml │ ├── test_phys_same.mli │ ├── test_popcount.ml │ ├── test_popcount.mli │ ├── test_printf.ml │ ├── test_printf.mli │ ├── test_queue.ml │ ├── test_queue.mli │ ├── test_quickcheck_let_syntax.mlt │ ├── test_quickcheck_signature.ml │ ├── test_quickcheck_signature.mli │ ├── test_result.ml │ ├── test_result.mli │ ├── test_sequence.ml │ ├── test_sequence.mli │ ├── test_set_interface.ml │ ├── test_set_interface.mli │ ├── test_set_once.ml │ ├── test_set_once.mli │ ├── test_sexp.ml │ ├── test_sexp.mli │ ├── test_sign.ml │ ├── test_sign.mli │ ├── test_signal.ml │ ├── test_signal.mli │ ├── test_source_code_position.ml │ ├── test_source_code_position.mli │ ├── test_stable.ml │ ├── test_stable.mli │ ├── test_staged.ml │ ├── test_staged.mli │ ├── test_string.ml │ ├── test_string.mli │ ├── test_string_id.ml │ ├── test_string_id.mli │ ├── test_substring.ml │ ├── test_substring.mli │ ├── test_sys.ml │ ├── test_sys.mli │ ├── test_time.ml │ ├── test_time.mli │ ├── test_time_ns.ml │ ├── test_time_ns.mli │ ├── test_timezone.ml │ ├── test_timezone.mli │ ├── test_timezone_full_data_protocol.ml │ ├── test_timezone_full_data_protocol.mli │ ├── test_timezone_js_loader.ml │ ├── test_timezone_js_loader.mli │ ├── test_tuple.ml │ ├── test_tuple.mli │ ├── test_uchar.ml │ ├── test_uchar.mli │ ├── test_union_find.ml │ ├── test_union_find.mli │ ├── test_unit.ml │ ├── test_unit.mli │ ├── test_unit_of_time.ml │ ├── test_unit_of_time.mli │ ├── test_validate_bound.ml │ ├── test_validate_bound.mli │ ├── test_validated.ml │ ├── test_validated.mli │ ├── type_immediacy_conv_unit_tests.ml │ ├── type_immediacy_conv_unit_tests.mli │ ├── type_immediacy_witness_unit_tests.ml │ └── type_immediacy_witness_unit_tests.mli └── top │ ├── core_install_printers.ml │ ├── core_top.ml │ ├── core_top.mllib │ └── dune ├── dune-project ├── filename_base ├── src │ ├── dune │ ├── filename_base.ml │ └── filename_base.mli └── test │ ├── test_filename.ml │ └── test_filename.mli ├── heap_block ├── dune ├── heap_block.ml ├── heap_block.mli ├── heap_block_stubs.c ├── runtime.js └── runtime.wat └── validate ├── bench ├── dune ├── validate_bench.ml └── validate_bench.mli ├── src ├── dune ├── validate.ml └── validate.mli └── test ├── dune ├── test_validate.ml ├── test_validate.mli ├── validate_fields_folder.mlt └── validate_test.ml /.gitignore: -------------------------------------------------------------------------------- 1 | _build 2 | *.install 3 | *.merlin 4 | _opam 5 | 6 | -------------------------------------------------------------------------------- /.ocamlformat: -------------------------------------------------------------------------------- 1 | profile=janestreet 2 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | The MIT License 2 | 3 | Copyright (c) 2008--2025 Jane Street Group, LLC 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | INSTALL_ARGS := $(if $(PREFIX),--prefix $(PREFIX),) 2 | 3 | default: 4 | dune build 5 | 6 | install: 7 | dune install $(INSTALL_ARGS) 8 | 9 | uninstall: 10 | dune uninstall $(INSTALL_ARGS) 11 | 12 | reinstall: uninstall install 13 | 14 | clean: 15 | dune clean 16 | 17 | .PHONY: default install uninstall reinstall clean 18 | -------------------------------------------------------------------------------- /base_for_tests/README.org: -------------------------------------------------------------------------------- 1 | * Base library for tests 2 | 3 | Base_for_tests provides helpers for generating tests for libraries 4 | using Base, especially for some functors in Base such as =Blit.Make= 5 | or =Binary_searchable.Make=. 6 | -------------------------------------------------------------------------------- /base_for_tests/src/base_for_tests.ml: -------------------------------------------------------------------------------- 1 | module Test_binary_searchable = Test_binary_searchable 2 | module Test_binary_searchable_intf = Test_binary_searchable_intf 3 | module Test_blit = Test_blit 4 | module Test_blit_intf = Test_blit_intf 5 | -------------------------------------------------------------------------------- /base_for_tests/src/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name base_for_tests) 3 | (public_name core.base_for_tests) 4 | (libraries base) 5 | (preprocess 6 | (pps ppx_base ppx_inline_test ppx_sexp_conv ppx_sexp_message))) 7 | -------------------------------------------------------------------------------- /base_for_tests/src/test_binary_searchable.mli: -------------------------------------------------------------------------------- 1 | include Test_binary_searchable_intf.Test_binary_searchable 2 | -------------------------------------------------------------------------------- /base_for_tests/src/test_blit.mli: -------------------------------------------------------------------------------- 1 | include Test_blit_intf.Test_blit 2 | -------------------------------------------------------------------------------- /command/src/command.mli: -------------------------------------------------------------------------------- 1 | include Command_intf.Command (** @inline *) 2 | -------------------------------------------------------------------------------- /command/src/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name command) 3 | (public_name core.command) 4 | (libraries base filename_base parsexp sexplib stdio univ_map) 5 | (preprocess 6 | (pps ppx_jane -require-template-extension ppx_optcomp))) 7 | -------------------------------------------------------------------------------- /command/src/env_var.ml: -------------------------------------------------------------------------------- 1 | open! Base 2 | open! Import 3 | 4 | type t = 5 | | COMMAND_OUTPUT_INSTALLATION_BASH 6 | | COMMAND_OUTPUT_HELP_SEXP 7 | | COMP_CWORD 8 | [@@deriving compare ~localize, enumerate, sexp_of] 9 | 10 | let to_string t = Sexp.to_string (sexp_of_t t) 11 | -------------------------------------------------------------------------------- /command/src/env_var.mli: -------------------------------------------------------------------------------- 1 | open! Base 2 | open! Import 3 | 4 | (** [Command_env_var] collects all the environment variables used by [Command]. 5 | 6 | We define them centrally because some services that wrap [Command] calls need to know 7 | to special case them. *) 8 | type t = 9 | | COMMAND_OUTPUT_INSTALLATION_BASH 10 | | COMMAND_OUTPUT_HELP_SEXP 11 | | COMP_CWORD 12 | [@@deriving compare ~localize, enumerate, sexp_of] 13 | 14 | val to_string : t -> string 15 | -------------------------------------------------------------------------------- /command/src/import.ml: -------------------------------------------------------------------------------- 1 | include struct 2 | open Stdio 3 | 4 | let eprintf = eprintf 5 | let printf = printf 6 | let print_s = print_s 7 | let print_string = print_string 8 | let print_endline = print_endline 9 | let prerr_endline = prerr_endline 10 | 11 | module In_channel = In_channel 12 | end 13 | 14 | include struct 15 | open Base.Printf 16 | 17 | let sprintf = sprintf 18 | let failwithf = failwithf 19 | let ksprintf = ksprintf 20 | end 21 | -------------------------------------------------------------------------------- /core.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | maintainer: "Jane Street developers" 3 | authors: ["Jane Street Group, LLC"] 4 | homepage: "https://github.com/janestreet/core" 5 | bug-reports: "https://github.com/janestreet/core/issues" 6 | dev-repo: "git+https://github.com/janestreet/core.git" 7 | doc: "https://ocaml.janestreet.com/ocaml-core/latest/doc/core/index.html" 8 | license: "MIT" 9 | build: [ 10 | ["dune" "build" "-p" name "-j" jobs] 11 | ] 12 | depends: [ 13 | "ocaml" {>= "5.1.0"} 14 | "base" 15 | "base_bigstring" 16 | "base_quickcheck" 17 | "bin_prot" 18 | "fieldslib" 19 | "jane-street-headers" 20 | "jst-config" 21 | "parsexp" 22 | "portable" 23 | "ppx_assert" 24 | "ppx_base" 25 | "ppx_diff" 26 | "ppx_expect" 27 | "ppx_hash" 28 | "ppx_inline_test" 29 | "ppx_jane" 30 | "ppx_optcomp" 31 | "ppx_sexp_conv" 32 | "ppx_sexp_message" 33 | "ppx_stable_witness" 34 | "sexplib" 35 | "splittable_random" 36 | "stdio" 37 | "string_dict" 38 | "time_now" 39 | "typerep" 40 | "univ_map" 41 | "uopt" 42 | "variantslib" 43 | "dune" {>= "3.17.0"} 44 | ] 45 | available: arch != "arm32" & arch != "x86_32" 46 | synopsis: "Industrial strength alternative to OCaml's standard library" 47 | description: " 48 | The Core suite of libraries is an industrial strength alternative to 49 | OCaml's standard library that was developed by Jane Street, the 50 | largest industrial user of OCaml. 51 | 52 | This is the system-independent part of Core. Unix-specific parts were moved to [core_unix]. 53 | " 54 | -------------------------------------------------------------------------------- /core/COPYRIGHT.txt: -------------------------------------------------------------------------------- 1 | Copyright (C) 2008- 2 | Jane Street Holding, LLC 3 | 1 New York Plaza, 33rd Floor 4 | New York, NY 10004 5 | USA 6 | 7 | email: opensource-contacts@janestreet.com 8 | 9 | The contents of some files in this distribution was derived from external 10 | sources with compatible licenses. The original copyright and license 11 | notice was preserved in the affected files. 12 | -------------------------------------------------------------------------------- /core/INRIA-DISCLAIMER.txt: -------------------------------------------------------------------------------- 1 | THIS SOFTWARE IS PROVIDED BY INRIA AND CONTRIBUTORS "AS IS" AND ANY 2 | EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 3 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 4 | PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL INRIA OR ITS CONTRIBUTORS BE 5 | LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 6 | CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF 7 | SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR 8 | BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, 9 | WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE 10 | OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN 11 | IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 12 | 13 | -------------------------------------------------------------------------------- /core/MLton-license.txt: -------------------------------------------------------------------------------- 1 | This is the license for MLton, a whole-program optimizing compiler for 2 | the Standard ML programming language. Send comments and questions to 3 | MLton@mlton.org. 4 | 5 | MLton COPYRIGHT NOTICE, LICENSE AND DISCLAIMER. 6 | 7 | Copyright (C) 1999-2009 Henry Cejtin, Matthew Fluet, Suresh 8 | Jagannathan, and Stephen Weeks. 9 | Copyright (C) 1997-2000 by the NEC Research Institute 10 | 11 | Permission to use, copy, modify, and distribute this software and its 12 | documentation for any purpose and without fee is hereby granted, 13 | provided that the above copyright notice appear in all copies and that 14 | both the copyright notice and this permission notice and warranty 15 | disclaimer appear in supporting documentation, and that the name of 16 | the above copyright holders, or their entities, not be used in 17 | advertising or publicity pertaining to distribution of the software 18 | without specific, written prior permission. 19 | 20 | The above copyright holders disclaim all warranties with regard to 21 | this software, including all implied warranties of merchantability and 22 | fitness. In no event shall the above copyright holders be liable for 23 | any special, indirect or consequential damages or any damages 24 | whatsoever resulting from loss of use, data or profits, whether in an 25 | action of contract, negligence or other tortious action, arising out 26 | of or in connection with the use or performance of this software. 27 | -------------------------------------------------------------------------------- /core/README.md: -------------------------------------------------------------------------------- 1 | Portable standard library for OCaml 2 | =================================== 3 | 4 | Core is an industrial-strength alternative to the OCaml standard 5 | library. It was developed by Jane Street, which is the largest 6 | industrial user of OCaml. Core works with Javascript. It provides an 7 | overlay on the usual namespace, so the best way to use it is to start 8 | your file with: 9 | 10 | ```ocaml 11 | open! Core 12 | ``` 13 | 14 | ## Relationship to Core and Base 15 | 16 | In sum: 17 | 18 | - **Base**: Minimal stdlib replacement. Portable and lightweight and 19 | intended to be highly stable. 20 | 21 | - **Core**: Extension of Base. More fully featured, with more code and 22 | dependencies, and APIs that evolve more quickly. Portable, and works 23 | on Javascript. 24 | 25 | Many of Core's modules are extensions of modules in Base, where the 26 | Core version adds `bin_io` support or locks in an API with 27 | `Stable`. Some modules, like `Core.Map`, extend their Base equivalents 28 | to follow Core conventions for the use of comparators. 29 | 30 | ------ 31 | 32 | Please report bugs and feature requests on 33 | [GitHub](https://github.com/janestreet/core). For everything else you 34 | can contact us at . 35 | 36 | You can find all of Jane Street's open-source libraries on 37 | [GitHub](https://github.com/janestreet). 38 | 39 | Documentation can be found 40 | [here](https://ocaml.janestreet.com/ocaml-core/latest/doc/core/index.html). 41 | -------------------------------------------------------------------------------- /core/THIRD-PARTY.txt: -------------------------------------------------------------------------------- 1 | The repository contains 3rd-party code in the following locations and 2 | under the following licenses: 3 | 4 | - src/union_find.ml and src/union_find.mli: based on an implementation 5 | by Henry Matthew Fluet, Suresh Jagannathan, and Stephen 6 | Weeks. License can be found in MLton-license.txt 7 | 8 | - various files in src/ are based on INRIA's OCaml 9 | distribution. Relicensed under MIT, as permitted under the 10 | Caml License for Consortium members: 11 | 12 | http://caml.inria.fr/consortium/license.en.html 13 | 14 | See also the disclaimer INRIA-DISCLAIMER.txt. 15 | 16 | - strftime.js in src/ is based on https://github.com/samsonjs/strftime 17 | License can be found at: 18 | 19 | http://sjs.mit-license.org 20 | 21 | See copy strftime.js-license.txt 22 | 23 | -------------------------------------------------------------------------------- /core/bench-bin/array_iter.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | module Bench = Core_bench.Bench 3 | 4 | let () = 5 | let a = Array.init 1000 ~f:Fn.id in 6 | let test_array_iter = 7 | Bench.Test.create ~name:"array_iter" (fun () -> 8 | Array.iter a ~f:(fun i -> if i > 2000 then assert false)) 9 | in 10 | let test_array_for = 11 | Bench.Test.create ~name:"array_for" (fun () -> 12 | let length = Array.length a - 1 in 13 | for i = 0 to length do 14 | if i > 2000 then assert false 15 | done) 16 | in 17 | Bench.bench [ test_array_iter; test_array_for ] 18 | ;; 19 | -------------------------------------------------------------------------------- /core/bench-bin/core_stack.ml: -------------------------------------------------------------------------------- 1 | open! Core 2 | module Stack = Core.Stack 3 | module Bench = Core_bench.Bench 4 | 5 | let () = 6 | Bench.bench 7 | [ Bench.Test.create 8 | ~name:"Stack.fold" 9 | (let s = Stack.of_list (List.init 100 ~f:Fn.id) in 10 | fun () -> ignore (Stack.fold s ~init:0 ~f:( + ) : int)) 11 | ; Bench.Test.create 12 | ~name:"stack_push_pop" 13 | (let s = Stack.create () in 14 | Stack.push s (); 15 | fun () -> 16 | for _ = 1 to 10 do 17 | Stack.push s (); 18 | Stack.pop_exn s 19 | done) 20 | ] 21 | ;; 22 | -------------------------------------------------------------------------------- /core/bench-bin/core_string_search_pattern.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/bench-bin/dequeue.ml: -------------------------------------------------------------------------------- 1 | open! Core 2 | module Bench = Core_bench.Bench 3 | 4 | let () = 5 | let d = Deque.create () in 6 | Deque.enqueue_front d (); 7 | Bench.bench 8 | [ Bench.Test.create ~name:"dequeue_push_pop" (fun () -> 9 | for _ = 1 to 10 do 10 | Deque.enqueue_front d (); 11 | Deque.dequeue_front_exn d 12 | done) 13 | ] 14 | ;; 15 | -------------------------------------------------------------------------------- /core/bench-bin/dune: -------------------------------------------------------------------------------- 1 | (executables 2 | (modes byte exe) 3 | (names array_iter array_queue bench_hashtbl bench_map core_stack 4 | core_string_search_pattern dequeue hashtbl_bench immediate_bench 5 | ordering_container string_escaping time_to_string) 6 | (libraries core_unix.command_unix core core_bench core_kernel.pairing_heap 7 | core_kernel.pooled_hashtbl ppx_hash.runtime-lib pcre re2 8 | shell.string_extended) 9 | (preprocess 10 | (pps ppx_jane))) 11 | -------------------------------------------------------------------------------- /core/bench-bin/hashtbl_bench.mli: -------------------------------------------------------------------------------- 1 | (* intentionally blank *) 2 | -------------------------------------------------------------------------------- /core/bench-bin/immediate_bench.ml: -------------------------------------------------------------------------------- 1 | open! Core 2 | open Core_bench 3 | module Always = Type_immediacy.Always 4 | 5 | module M = struct 6 | type t = 7 | | A 8 | | B 9 | | C 10 | [@@deriving typerep] 11 | 12 | let always = Always.of_typerep_exn typerep_of_t 13 | end 14 | 15 | let tests = 16 | [ Bench.Test.create ~name:"Always.value_as_int" (fun () -> 17 | ignore (Always.value_as_int M.always M.A : int)) 18 | ] 19 | ;; 20 | 21 | let () = Command_unix.run (Bench.make_command tests) 22 | -------------------------------------------------------------------------------- /core/bench-bin/string_escaping.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | open Poly 3 | module Bench = Core_bench.Bench 4 | 5 | let () = 6 | let module E = String.Escaping in 7 | let escape = 8 | Staged.unstage (E.escape ~escapeworthy:[ 'x'; 'y'; 'z' ] ~escape_char:'\\') 9 | in 10 | let unescape = Staged.unstage (E.unescape ~escape_char:'\\') in 11 | let rex = Pcre.regexp "[xyz\\\\]" in 12 | let unrex = Pcre.regexp "\\\\." in 13 | let escape_pcre s = Pcre.substitute ~rex ~subst:(fun s -> "\\" ^ s) s in 14 | let unescape_pcre s = 15 | Pcre.substitute ~rex:unrex ~subst:(fun s -> Char.to_string s.[1]) s 16 | in 17 | let strings = 18 | [ "aaa" 19 | ; "xyz" 20 | ; "aaaaaaaaa" 21 | ; "aaxaaxaax" 22 | ; "abcde\\abcde\\abcde\\abcde\\abcde\\abcde\\" 23 | ; "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" 24 | ; "aaaaaaaaaaaaaaaaaa\\aaaaaaaaaaaaaaaaaaaaaaa" 25 | ; "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" 26 | ] 27 | in 28 | Bench.bench 29 | (List.concat_map strings ~f:(fun str -> 30 | let go name escape unescape = 31 | Bench.Test.create ~name:(sprintf "%s-%s" name str) (fun () -> 32 | assert (unescape (escape str) = str)) 33 | in 34 | [ go "String.Escaping" escape unescape; go "Pcre" escape_pcre unescape_pcre ])) 35 | ;; 36 | -------------------------------------------------------------------------------- /core/bench-bin/time_to_string.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | open Core_bench 3 | 4 | let date = Date.create_exn ~d:14 ~m:Month.Jul ~y:1789 5 | 6 | let () = 7 | Command_unix.run 8 | (Bench.make_command 9 | [ Bench.Test.create ~name:"Date.to_string" (fun () -> 10 | ignore (Date.to_string date : string)) 11 | ]) 12 | ;; 13 | -------------------------------------------------------------------------------- /core/replace_caml_modify_for_testing/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (foreign_stubs 3 | (language c) 4 | (names replace_caml_modify_for_testing_stub)) 5 | (name replace_caml_modify_for_testing) 6 | (library_flags -cclib -Xlinker -cclib --wrap -cclib -Xlinker -cclib 7 | caml_modify -cclib -Xlinker -cclib --wrap -cclib -Xlinker -cclib 8 | caml_modify_local) 9 | (preprocess 10 | (pps ppx_inline_test))) 11 | -------------------------------------------------------------------------------- /core/replace_caml_modify_for_testing/replace_caml_modify_for_testing.ml: -------------------------------------------------------------------------------- 1 | external count : unit -> int = "replace_caml_modify_for_testing_count" [@@noalloc] 2 | external reset : unit -> unit = "replace_caml_modify_for_testing_reset" [@@noalloc] 3 | 4 | let%test_unit _ = 5 | let x = Array.make (32 * 1024) [ Random.int 10 ] in 6 | let v = [ Random.int 10 ] in 7 | let n = count () in 8 | x.(0) <- v; 9 | assert (count () = n + 1); 10 | let x = Array.make (32 * 1024) 0 in 11 | let n = count () in 12 | x.(0) <- 2; 13 | assert (count () = n) 14 | ;; 15 | -------------------------------------------------------------------------------- /core/replace_caml_modify_for_testing/replace_caml_modify_for_testing.mli: -------------------------------------------------------------------------------- 1 | (** Increment a counter whenever [caml_modify] is called. 2 | 3 | This library wraps caml_modify at the C level, and should only be used in testing 4 | code. *) 5 | 6 | (** [count ()] returns the number of times [caml_modify] has been called since the last 7 | call to {!reset}. *) 8 | external count : unit -> int = "replace_caml_modify_for_testing_count" 9 | [@@noalloc] 10 | 11 | (** [reset ()] reset the counter to [0]. *) 12 | external reset : unit -> unit = "replace_caml_modify_for_testing_reset" 13 | [@@noalloc] 14 | -------------------------------------------------------------------------------- /core/replace_caml_modify_for_testing/replace_caml_modify_for_testing_stub.c: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | CAMLextern void __real_caml_modify(value *fp, value v); 4 | 5 | static long count = 0; 6 | 7 | void (*replace_caml_modify_hook)(void) = NULL; 8 | 9 | CAMLprim void __wrap_caml_modify(value *fp, value v) 10 | { 11 | count++; 12 | __real_caml_modify(fp, v); 13 | if (replace_caml_modify_hook != NULL) replace_caml_modify_hook (); 14 | } 15 | 16 | CAMLprim value replace_caml_modify_for_testing_count() 17 | { 18 | return Val_long(count); 19 | } 20 | 21 | CAMLprim value replace_caml_modify_for_testing_reset() 22 | { 23 | count = 0; 24 | return Val_unit; 25 | } 26 | 27 | CAMLextern void __real_caml_modify_local(value obj, intnat i, value val); 28 | 29 | CAMLprim void __wrap_caml_modify_local(value obj, intnat i, value val) 30 | { 31 | long next_count = count + 1; 32 | __real_caml_modify_local(obj, i, val); 33 | count = next_count; 34 | if (replace_caml_modify_hook != NULL) replace_caml_modify_hook (); 35 | } 36 | -------------------------------------------------------------------------------- /core/src/arg.ml: -------------------------------------------------------------------------------- 1 | open! Import 2 | include Stdlib.Arg 3 | 4 | type t = key * spec * doc 5 | 6 | let sort_and_align lst = 7 | align (Base.List.sort lst ~compare:(fun (a, _, _) (b, _, _) -> String.compare a b)) 8 | ;; 9 | -------------------------------------------------------------------------------- /core/src/arg.mli: -------------------------------------------------------------------------------- 1 | (** INRIA's original command-line parsing library. 2 | 3 | The [Command] module is generally recommended over direct use of this library. *) 4 | 5 | open! Import 6 | 7 | include module type of Stdlib.Arg (** @inline *) 8 | 9 | type t = key * spec * doc 10 | 11 | (** Like [align], except that the specification list is also sorted by key *) 12 | val sort_and_align : (key * spec * doc) list -> (key * spec * doc) list 13 | -------------------------------------------------------------------------------- /core/src/atomic.ml: -------------------------------------------------------------------------------- 1 | open! Import 2 | include Portable.Atomic 3 | 4 | include struct 5 | open Bin_prot 6 | 7 | let bin_shape_t bin_shape_el = bin_shape_el 8 | 9 | [%%template 10 | [@@@mode.default m = (local, global)] 11 | 12 | let bin_size_t bin_size_el t = bin_size_el (get t |> Modes.Contended.cross) 13 | 14 | let bin_write_t bin_write_el buf ~pos t = 15 | bin_write_el buf ~pos (get t |> Modes.Contended.cross) 16 | ;;] 17 | 18 | let bin_read_t bin_read_el buf ~pos_ref = 19 | make (bin_read_el buf ~pos_ref |> Modes.Portable.cross) 20 | ;; 21 | 22 | let __bin_read_t__ bin_read_el buf ~pos_ref _n = make (bin_read_el buf ~pos_ref) 23 | 24 | let bin_writer_t : _ Type_class.S1.writer = 25 | fun bin_writer -> 26 | { size = (fun v -> bin_size_t bin_writer.size v) 27 | ; write = (fun buf ~pos v -> bin_write_t bin_writer.write buf ~pos v) 28 | } 29 | ;; 30 | 31 | let bin_reader_t : _ Type_class.S1.reader = 32 | fun bin_reader -> 33 | { read = (fun buf ~pos_ref -> bin_read_t bin_reader.read buf ~pos_ref) 34 | ; vtag_read = 35 | (fun _buf ~pos_ref _n -> 36 | Common.raise_variant_wrong_type "Core.Atomic.bin_reader_t" !pos_ref) 37 | } 38 | ;; 39 | 40 | let bin_t : _ Type_class.S1.t = 41 | fun type_class -> 42 | { shape = bin_shape_t type_class.shape 43 | ; writer = bin_writer_t type_class.writer 44 | ; reader = bin_reader_t type_class.reader 45 | } 46 | ;; 47 | end 48 | 49 | let stable_witness _ = Stable_witness.assert_stable 50 | -------------------------------------------------------------------------------- /core/src/atomic.mli: -------------------------------------------------------------------------------- 1 | (** @inline *) 2 | include module type of struct 3 | include Portable.Atomic 4 | end 5 | 6 | [%%rederive: type nonrec 'a t = 'a t [@@deriving bin_shape, stable_witness]] 7 | [%%rederive: type nonrec 'a t = 'a t [@@deriving bin_write ~localize]] 8 | [%%rederive: type nonrec 'a t = 'a t [@@deriving bin_read]] 9 | [%%rederive: type nonrec 'a t = 'a t [@@deriving bin_type_class]] 10 | -------------------------------------------------------------------------------- /core/src/bag.ml: -------------------------------------------------------------------------------- 1 | open! Import 2 | include Bag_intf 3 | 4 | include ( 5 | Doubly_linked : 6 | sig 7 | include Doubly_linked.S 8 | end) 9 | 10 | let add = insert_first 11 | let add_unit t v = add t v |> (ignore : _ Elt.t -> unit) 12 | let elts t = fold_elt t ~init:[] ~f:(fun acc elt -> elt :: acc) 13 | let remove_one = remove_first 14 | let choose = first_elt 15 | 16 | let until_empty t f = 17 | let rec loop () = 18 | Option.iter (remove_one t) ~f:(fun v -> 19 | f v; 20 | loop ()) 21 | in 22 | loop () 23 | ;; 24 | -------------------------------------------------------------------------------- /core/src/bag.mli: -------------------------------------------------------------------------------- 1 | include Bag_intf.Bag (** @inline *) 2 | -------------------------------------------------------------------------------- /core/src/bigbuffer.ml: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/janestreet/core/1a1290e5789200e2dd50a87a17774f4eb75e82c6/core/src/bigbuffer.ml -------------------------------------------------------------------------------- /core/src/bigbuffer_internal.ml: -------------------------------------------------------------------------------- 1 | open! Import 2 | 3 | type t = 4 | { mutable bstr : Bigstring.t 5 | ; mutable pos : int 6 | ; mutable len : int 7 | ; init : Bigstring.t 8 | } 9 | [@@deriving sexp_of] 10 | 11 | let resize buf more = 12 | let min_len = buf.len + more in 13 | let new_len = min_len + min_len in 14 | let new_buf = Bigstring.create new_len in 15 | Bigstring.blito ~src:buf.bstr ~src_len:buf.pos ~dst:new_buf (); 16 | buf.bstr <- new_buf; 17 | buf.len <- new_len 18 | ;; 19 | -------------------------------------------------------------------------------- /core/src/bigbuffer_internal.mli: -------------------------------------------------------------------------------- 1 | open! Import 2 | 3 | type t = 4 | { mutable bstr : Bigstring.t 5 | ; mutable pos : int 6 | ; mutable len : int 7 | ; init : Bigstring.t 8 | } 9 | [@@deriving sexp_of] 10 | 11 | val resize : t -> int -> unit 12 | -------------------------------------------------------------------------------- /core/src/bigsubstring.ml: -------------------------------------------------------------------------------- 1 | open! Import 2 | 3 | include%template Make_substring.F [@modality portable] (struct 4 | type t = Bigstring.t [@@deriving quickcheck] 5 | 6 | let create = Bigstring.create 7 | let length = Bigstring.length 8 | let get t i = Bigstring.get t i 9 | 10 | module Blit = Make_substring.Blit 11 | 12 | let blit = Blit.bigstring_bigstring 13 | let blit_to_string = Blit.bigstring_bytes 14 | let blit_to_bytes = Blit.bigstring_bytes 15 | let blit_to_bigstring = Blit.bigstring_bigstring 16 | let blit_from_string = Blit.string_bigstring 17 | let blit_from_bigstring = Blit.bigstring_bigstring 18 | end) 19 | -------------------------------------------------------------------------------- /core/src/bigsubstring.mli: -------------------------------------------------------------------------------- 1 | (** Substring type based on [Bigarray], for use in I/O and C-bindings *) 2 | 3 | open! Import 4 | 5 | include Make_substring.S with type base = Bigstring.t (** @inline *) 6 | -------------------------------------------------------------------------------- /core/src/binable.ml: -------------------------------------------------------------------------------- 1 | open! Import 2 | include Binable_intf 3 | include Binable0 4 | 5 | (* [of_string] and [to_string] can't go in binable0.ml due to a cyclic dependency. *) 6 | [%%template 7 | [@@@mode.default m = (global, local)] 8 | 9 | let of_string m string = (of_bigstring [@mode m]) m (Bigstring.of_string string) 10 | let to_string m t = Bigstring.to_string ((to_bigstring [@mode m]) m t)] 11 | -------------------------------------------------------------------------------- /core/src/binable.mli: -------------------------------------------------------------------------------- 1 | include Binable_intf.Binable 2 | -------------------------------------------------------------------------------- /core/src/binable0.mli: -------------------------------------------------------------------------------- 1 | include Binable_intf.Binable0 2 | -------------------------------------------------------------------------------- /core/src/binary_searchable.ml: -------------------------------------------------------------------------------- 1 | include Base.Binary_searchable 2 | include Binary_searchable_intf 3 | -------------------------------------------------------------------------------- /core/src/binary_searchable.mli: -------------------------------------------------------------------------------- 1 | (** This module extends the {{!Base.Binary_searchable} [Base.Binary_searchable]} module. *) 2 | 3 | include Binary_searchable_intf.Binary_searchable (** @inline *) 4 | -------------------------------------------------------------------------------- /core/src/binary_searchable_intf.ml: -------------------------------------------------------------------------------- 1 | (** This module extends {!Base.Binary_searchable}. *) 2 | 3 | open Base.Binary_searchable 4 | 5 | module type S0_permissions = sig 6 | open Perms.Export 7 | 8 | type elt 9 | type -'perms t 10 | 11 | val binary_search : ([> read ] t, elt, 'key) binary_search 12 | val binary_search_segmented : ([> read ] t, elt) binary_search_segmented 13 | end 14 | 15 | module type S1_permissions = sig 16 | open Perms.Export 17 | 18 | type ('a, -'perms) t 19 | 20 | val binary_search : (('a, [> read ]) t, 'a, 'key) binary_search 21 | val binary_search_segmented : (('a, [> read ]) t, 'a) binary_search_segmented 22 | end 23 | 24 | module type Binary_searchable = sig 25 | include module type of struct 26 | include Base.Binary_searchable 27 | end 28 | 29 | module type S0_permissions = S0_permissions 30 | module type S1_permissions = S1_permissions 31 | end 32 | -------------------------------------------------------------------------------- /core/src/blit.ml: -------------------------------------------------------------------------------- 1 | include Base.Blit 2 | include Blit_intf 3 | -------------------------------------------------------------------------------- /core/src/blit.mli: -------------------------------------------------------------------------------- 1 | (** This module extends {{!Base.Blit} [Base.Blit]}. *) 2 | 3 | include Blit_intf.Blit (** @inline *) 4 | -------------------------------------------------------------------------------- /core/src/blit_intf.ml: -------------------------------------------------------------------------------- 1 | (** This module extends the Base [Blit] module *) 2 | 3 | open Base.Blit 4 | 5 | (*_ These are not implemented less-general-in-terms-of-more-general because odoc produces 6 | unreadable documentation in that case, with or without [inline] on [include]. *) 7 | 8 | module type S_permissions = sig 9 | open Perms.Export 10 | 11 | type -'perms t 12 | 13 | val blit : ([> read ] t, [> write ] t) blit 14 | val blito : ([> read ] t, [> write ] t) blito 15 | val unsafe_blit : ([> read ] t, [> write ] t) blit 16 | val sub : ([> read ] t, [< _ perms ] t) sub 17 | val subo : ([> read ] t, [< _ perms ] t) subo 18 | end 19 | 20 | module type S1_permissions = sig 21 | open Perms.Export 22 | 23 | type ('a, -'perms) t 24 | 25 | val blit : (('a, [> read ]) t, ('a, [> write ]) t) blit 26 | val blito : (('a, [> read ]) t, ('a, [> write ]) t) blito 27 | val unsafe_blit : (('a, [> read ]) t, ('a, [> write ]) t) blit 28 | val sub : (('a, [> read ]) t, ('a, [< _ perms ]) t) sub 29 | val subo : (('a, [> read ]) t, ('a, [< _ perms ]) t) subo 30 | end 31 | 32 | module type Blit = sig 33 | (** @inline *) 34 | include module type of struct 35 | include Base.Blit 36 | end 37 | 38 | module type S_permissions = S_permissions 39 | module type S1_permissions = S1_permissions 40 | end 41 | -------------------------------------------------------------------------------- /core/src/bool.mli: -------------------------------------------------------------------------------- 1 | (** This module extends {{!Base.Bool} [Base.Bool]}. *) 2 | 3 | type t = bool [@@deriving bin_io ~localize, typerep] 4 | 5 | include module type of Base.Bool with type t := t 6 | 7 | include%template 8 | Identifiable.S 9 | [@mode local] 10 | with type t := t 11 | and type comparator_witness := Base.Bool.comparator_witness 12 | 13 | (** Human readable parsing. Accepted inputs are (case insensitive): 14 | - true/false 15 | - yes/no 16 | - 1/0 17 | - t/f 18 | - y/n *) 19 | val of_string_hum : string -> t 20 | 21 | include Quickcheckable.S with type t := t 22 | 23 | module Stable : sig 24 | module V1 : sig 25 | type nonrec t = t 26 | [@@deriving 27 | bin_io ~localize 28 | , compare ~localize 29 | , equal ~localize 30 | , hash 31 | , sexp 32 | , sexp_grammar 33 | , typerep] 34 | 35 | include 36 | Stable_comparable.With_stable_witness.V1 37 | with type t := t 38 | with type comparator_witness = comparator_witness 39 | end 40 | end 41 | -------------------------------------------------------------------------------- /core/src/bounded_index.mli: -------------------------------------------------------------------------------- 1 | include Bounded_index_intf.Bounded_index (** @inline *) 2 | -------------------------------------------------------------------------------- /core/src/byte_units0.mli: -------------------------------------------------------------------------------- 1 | open! Import 2 | module Repr = Int63 3 | 4 | type t [@@deriving compare ~localize, hash, sexp_of, typerep] [@@immediate64] 5 | 6 | val to_string : t -> string 7 | val to_string_hum : t -> string 8 | val of_repr : Repr.t -> t 9 | val to_repr : t -> Repr.t 10 | val bytes_int_exn : t -> int 11 | -------------------------------------------------------------------------------- /core/src/bytes.ml: -------------------------------------------------------------------------------- 1 | open! Import 2 | open Base_quickcheck.Export 3 | 4 | module Stable = struct 5 | module V1 = struct 6 | include Base.Bytes 7 | 8 | type t = bytes 9 | [@@deriving bin_io ~localize, globalize, quickcheck, stable_witness, typerep] 10 | end 11 | end 12 | 13 | include Stable.V1 14 | 15 | include%template Comparable.Validate [@modality portable] (Base.Bytes) 16 | 17 | include%template Hexdump.Of_indexable [@modality portable] (struct 18 | type t = bytes 19 | 20 | let length = length 21 | let get t i = get t i 22 | end) 23 | 24 | let gen' char_gen = String.gen' char_gen |> Quickcheck.Generator.map ~f:of_string 25 | 26 | let gen_with_length len char_gen = 27 | String.gen_with_length len char_gen |> Quickcheck.Generator.map ~f:of_string 28 | ;; 29 | -------------------------------------------------------------------------------- /core/src/bytes.mli: -------------------------------------------------------------------------------- 1 | (** This module extends {{!Base.Bytes} [Base.Bytes]}. *) 2 | 3 | open! Import 4 | 5 | type t = bytes [@@deriving bin_io ~localize, typerep] 6 | 7 | (** @inline *) 8 | include module type of struct 9 | include Base.Bytes 10 | end 11 | with type t := t 12 | 13 | include Hexdump.S with type t := t 14 | include Quickcheckable.S with type t := t 15 | 16 | (** Like [gen], but generate bytes with the given distribution of characters. *) 17 | val gen' : char Quickcheck.Generator.t -> t Quickcheck.Generator.t 18 | 19 | (** Like [gen'], but generate bytes with the given length. *) 20 | val gen_with_length : int -> char Quickcheck.Generator.t -> t Quickcheck.Generator.t 21 | 22 | (** Note that [bytes] is already stable by itself, since as a primitive type it is an 23 | integral part of the sexp / bin_io protocol. [Bytes.Stable] exists only to provide 24 | interface uniformity with other stable types. *) 25 | module Stable : sig 26 | module V1 : sig 27 | type nonrec t = t [@@deriving bin_io ~localize, equal ~localize, globalize] 28 | type nonrec comparator_witness = comparator_witness 29 | 30 | include%template 31 | Stable_module_types.With_stable_witness.S0 32 | [@mode local] 33 | with type t := t 34 | with type comparator_witness := comparator_witness 35 | end 36 | end 37 | -------------------------------------------------------------------------------- /core/src/command_internal.ml: -------------------------------------------------------------------------------- 1 | open! Import 2 | open! Std_internal 3 | include Command 4 | 5 | module Arg_type = struct 6 | include Arg_type 7 | 8 | module Export = struct 9 | include Export 10 | 11 | let date = create Date.of_string 12 | let percent = create Percent.of_string 13 | let host_and_port = create Host_and_port.of_string 14 | end 15 | end 16 | 17 | module Param = struct 18 | include ( 19 | Param : 20 | sig 21 | include module type of Param with module Arg_type := Param.Arg_type 22 | end) 23 | 24 | module Arg_type = Arg_type 25 | include Arg_type.Export 26 | end 27 | 28 | module Spec = struct 29 | include ( 30 | Spec : 31 | sig 32 | include module type of Spec with module Arg_type := Spec.Arg_type 33 | end) 34 | 35 | module Arg_type = Arg_type 36 | include Arg_type.Export 37 | end 38 | 39 | module Let_syntax = struct 40 | include Let_syntax 41 | 42 | module Let_syntax = struct 43 | include Let_syntax 44 | module Open_on_rhs = Param 45 | end 46 | end 47 | -------------------------------------------------------------------------------- /core/src/command_shape.mli: -------------------------------------------------------------------------------- 1 | open! Import 2 | open! Std_internal 3 | include module type of Command.Shape 4 | 5 | module%template Stable : sig 6 | module Anons : sig 7 | module Grammar : sig 8 | module V1 : Stable_without_comparator [@mode local] with type t = Anons.Grammar.t 9 | end 10 | 11 | module V2 : Stable_without_comparator [@mode local] with type t = Anons.t 12 | end 13 | 14 | module Flag_info : sig 15 | module V1 : Stable_without_comparator [@mode local] with type t = Flag_info.t 16 | end 17 | 18 | module Base_info : sig 19 | module V2 : Stable_without_comparator [@mode local] with type t = Base_info.t 20 | end 21 | 22 | module Group_info : sig 23 | module V2 : Stable1 with type 'a t = 'a Group_info.t 24 | end 25 | 26 | module Exec_info : sig 27 | module V3 : Stable_without_comparator [@mode local] with type t = Exec_info.t 28 | end 29 | 30 | module Fully_forced : sig 31 | module V1 : Stable_without_comparator [@mode local] with type t = Fully_forced.t 32 | end 33 | end 34 | -------------------------------------------------------------------------------- /core/src/comparable.mli: -------------------------------------------------------------------------------- 1 | include Comparable_intf.Comparable (** @inline *) 2 | -------------------------------------------------------------------------------- /core/src/comparator.ml: -------------------------------------------------------------------------------- 1 | open! Import 2 | module Comparator = Base.Comparator 3 | 4 | type ('a, 'witness) t = ('a, 'witness) Comparator.t 5 | 6 | module type Base_mask = module type of Comparator with type ('a, 'b) t := ('a, 'b) t 7 | 8 | include (Comparator : Base_mask) 9 | 10 | module%template Stable = struct 11 | module V1 = struct 12 | include Comparator_intf.Definitions.Stable.V1 13 | 14 | type nonrec ('a, 'witness) t = ('a, 'witness) t 15 | type ('a, 'b) comparator = ('a, 'b) t 16 | 17 | [@@@modality.default p = (portable, nonportable)] 18 | 19 | let make = (make [@modality p]) 20 | 21 | module Make = Make [@modality p] 22 | module Make1 = Make1 [@modality p] 23 | end 24 | end 25 | -------------------------------------------------------------------------------- /core/src/comparator.mli: -------------------------------------------------------------------------------- 1 | include Comparator_intf.Comparator 2 | -------------------------------------------------------------------------------- /core/src/container.ml: -------------------------------------------------------------------------------- 1 | include Base.Container 2 | include Container_intf 3 | -------------------------------------------------------------------------------- /core/src/container.mli: -------------------------------------------------------------------------------- 1 | (** Provides generic signatures for container data structures. 2 | 3 | These signatures include functions ([iter], [fold], [exists], [for_all], ...) that you 4 | would expect to find in any container. Used by including [Container.S0] or 5 | [Container.S1] in the signature for every container-like data structure ([Array], 6 | [List], [String], ...) to ensure a consistent interface. 7 | 8 | These signatures extend signatures exported by {!Base.Container_intf}. *) 9 | 10 | include Container_intf.Container (** @inline *) 11 | -------------------------------------------------------------------------------- /core/src/core_bigstring.h: -------------------------------------------------------------------------------- 1 | #ifndef __CORE_BIGSTRING_H 2 | #define __CORE_BIGSTRING_H 3 | 4 | #include 5 | 6 | /* Bigarray flags for creating a [Bigstring.t] */ 7 | #define CORE_BIGSTRING_FLAGS (CAML_BA_CHAR | CAML_BA_C_LAYOUT) 8 | 9 | /* Do not call [unmap] for bigstrings with kind [CAML_BA_MAPPED_FILE] */ 10 | #define CORE_BIGSTRING_DESTROY_DO_NOT_UNMAP 1 11 | 12 | /* Don't fail on bigstring with kind [CAML_BA_EXTERNAL] */ 13 | #define CORE_BIGSTRING_DESTROY_ALLOW_EXTERNAL 2 14 | 15 | /* Destroy a bigstring: 16 | 17 | - free the memory with [free] if it is managed by ocaml 18 | - reset all its dimmensions to 0 19 | - [unmap] if it is a memory-map 20 | - set its kind to [CAML_BA_EXTERNAL] 21 | */ 22 | void core_bigstring_destroy(value v, int flags); 23 | 24 | #endif /* __CORE_BIGSTRING_H */ 25 | -------------------------------------------------------------------------------- /core/src/core_bin_prot.ml: -------------------------------------------------------------------------------- 1 | open! Import 2 | include Bin_prot 3 | 4 | module Writer = struct 5 | type 'a t = 'a Bin_prot.Type_class.writer = 6 | { size : 'a Size.sizer 7 | ; write : 'a Write.writer 8 | } 9 | 10 | let to_bigstring t v = 11 | let len = t.size v in 12 | let buf = Bigstring.create len in 13 | let pos = t.write buf ~pos:0 v in 14 | assert (pos = Bigstring.length buf); 15 | buf 16 | ;; 17 | 18 | let to_string t v = 19 | let buf = to_bigstring t v in 20 | let str = Bigstring.to_string buf in 21 | Bigstring.unsafe_destroy buf; 22 | str 23 | ;; 24 | 25 | let to_bytes t v = 26 | let buf = to_bigstring t v in 27 | let str = Bigstring.to_bytes buf in 28 | Bigstring.unsafe_destroy buf; 29 | str 30 | ;; 31 | end 32 | 33 | module Reader = struct 34 | type 'a t = 'a Bin_prot.Type_class.reader = 35 | { read : 'a Read.reader 36 | ; vtag_read : 'a Read.vtag_reader 37 | } 38 | 39 | let of_bigstring t buf = 40 | let pos_ref = ref 0 in 41 | let v = t.read buf ~pos_ref in 42 | assert (!pos_ref = Bigstring.length buf); 43 | v 44 | ;; 45 | 46 | let of_bigstring_unsafe_destroy t buf = 47 | let v = of_bigstring t buf in 48 | Bigstring.unsafe_destroy buf; 49 | v 50 | ;; 51 | 52 | let of_string t string = Bigstring.of_string string |> of_bigstring_unsafe_destroy t 53 | let of_bytes t bytes = Bigstring.of_bytes bytes |> of_bigstring_unsafe_destroy t 54 | end 55 | -------------------------------------------------------------------------------- /core/src/core_bin_prot.mli: -------------------------------------------------------------------------------- 1 | open! Import 2 | include module type of Bin_prot 3 | 4 | module Writer : sig 5 | type 'a t = 'a Bin_prot.Type_class.writer = 6 | { size : 'a Size.sizer 7 | ; write : 'a Write.writer 8 | } 9 | 10 | val to_string : 'a t -> 'a -> string 11 | val to_bytes : 'a t -> 'a -> bytes 12 | val to_bigstring : 'a t -> 'a -> Bigstring.t 13 | end 14 | 15 | module Reader : sig 16 | type 'a t = 'a Bin_prot.Type_class.reader = 17 | { read : 'a Read.reader 18 | ; vtag_read : 'a Read.vtag_reader 19 | } 20 | 21 | val of_string : 'a t -> string -> 'a 22 | val of_bytes : 'a t -> bytes -> 'a 23 | val of_bigstring : 'a t -> Bigstring.t -> 'a 24 | end 25 | -------------------------------------------------------------------------------- /core/src/date.ml: -------------------------------------------------------------------------------- 1 | include Date0 2 | 3 | let of_time time ~zone = Time_float.to_date ~zone time 4 | let today ~zone = of_time (Time_float.now ()) ~zone 5 | let format = `Use_Date_unix 6 | let of_tm = `Use_Date_unix 7 | let parse = `Use_Date_unix 8 | -------------------------------------------------------------------------------- /core/src/date.mli: -------------------------------------------------------------------------------- 1 | (** Date module. *) 2 | 3 | include Date_intf.Date (** @inline *) 4 | -------------------------------------------------------------------------------- /core/src/date0.mli: -------------------------------------------------------------------------------- 1 | include Date0_intf.Date0 (** @inline *) 2 | -------------------------------------------------------------------------------- /core/src/date_cache.mli: -------------------------------------------------------------------------------- 1 | include Date_cache_intf.Date_cache (** @inline *) 2 | -------------------------------------------------------------------------------- /core/src/date_intf.ml: -------------------------------------------------------------------------------- 1 | module type Date = sig 2 | type t = Date0.t 3 | 4 | include module type of Date0 with type t := t (** @inline *) 5 | 6 | val of_time : Time_float.t -> zone:Zone.t -> t 7 | val today : zone:Zone.t -> t 8 | 9 | (** Deprecations *) 10 | 11 | val format : [ `Use_Date_unix ] [@@deprecated "[since 2021-03] Use [Date_unix]"] 12 | val of_tm : [ `Use_Date_unix ] [@@deprecated "[since 2021-03] Use [Date_unix]"] 13 | val parse : [ `Use_Date_unix ] [@@deprecated "[since 2021-03] Use [Date_unix]"] 14 | end 15 | -------------------------------------------------------------------------------- /core/src/day_of_week.mli: -------------------------------------------------------------------------------- 1 | (** Provides a variant type for days of the week ([Mon], [Tue], etc.) and convenience 2 | functions for converting these days into other formats, like sexp or string or ISO 3 | 8601 weekday number. *) 4 | 5 | include Day_of_week_intf.Day_of_week (** @inline *) 6 | -------------------------------------------------------------------------------- /core/src/deprecate_pipe_bang.ml: -------------------------------------------------------------------------------- 1 | external ( |! ) : 'a -> (('a -> 'b)[@local_opt]) -> 'b = "%revapply" 2 | -------------------------------------------------------------------------------- /core/src/deprecate_pipe_bang.mli: -------------------------------------------------------------------------------- 1 | external ( |! ) : 'a -> (('a -> 'b)[@local_opt]) -> 'b = "%revapply" 2 | [@@deprecated "[since 2016-07] Use [ |> ]"] 3 | -------------------------------------------------------------------------------- /core/src/deriving_hash.ml: -------------------------------------------------------------------------------- 1 | open! Import 2 | include Deriving_hash_intf 3 | 4 | module%template.portable Of_deriving_hash 5 | (Repr : S) 6 | (M : sig 7 | type t 8 | 9 | val to_repr : t -> Repr.t 10 | end) = 11 | struct 12 | let hash_fold_t state t = Repr.hash_fold_t state (M.to_repr t) 13 | let hash t = Ppx_hash_lib.Std.Hash.of_fold hash_fold_t t 14 | end 15 | -------------------------------------------------------------------------------- /core/src/deriving_hash.mli: -------------------------------------------------------------------------------- 1 | (** Generates hash functions from type expressions and definitions. *) 2 | 3 | include Deriving_hash_intf.Deriving_hash (** @inline *) 4 | -------------------------------------------------------------------------------- /core/src/deriving_hash_intf.ml: -------------------------------------------------------------------------------- 1 | open! Import 2 | 3 | module type S = sig 4 | type t [@@deriving hash] 5 | end 6 | 7 | module type Deriving_hash = sig 8 | module%template.portable Of_deriving_hash 9 | (Repr : S) 10 | (M : sig 11 | type t 12 | 13 | val to_repr : t -> Repr.t 14 | end) : S with type t := M.t 15 | end 16 | -------------------------------------------------------------------------------- /core/src/doubly_linked.mli: -------------------------------------------------------------------------------- 1 | include Doubly_linked_intf.Doubly_linked (** @inline *) 2 | -------------------------------------------------------------------------------- /core/src/dune: -------------------------------------------------------------------------------- 1 | (rule 2 | (targets config.h) 3 | (deps) 4 | (action 5 | (copy %{lib:jst-config:config.h} config.h))) 6 | 7 | (library 8 | (foreign_stubs 9 | (language c) 10 | (names bigstring_stubs md5_stubs array_stubs gc_stubs 11 | timezone_js_loader_stubs) 12 | (flags :standard -D_LARGEFILE64_SOURCE)) 13 | (name core) 14 | (public_name core) 15 | (libraries base base_bigstring base_for_tests base_quickcheck bin_prot 16 | command fieldslib filename_base heap_block bin_prot.shape 17 | ppx_diff.diffable ppx_expect.config_types jane-street-headers base.md5 18 | portable ppx_assert.runtime-lib ppx_hash.runtime-lib 19 | ppx_inline_test.runtime-lib sexplib splittable_random 20 | ppx_stable_witness.stable_witness stdio string_dict time_now typerep 21 | univ_map uopt validate variantslib) 22 | (ocamlopt_flags 23 | :standard 24 | (:include ocamlopt-flags)) 25 | (preprocess 26 | (pps ppx_jane -require-template-extension ppx_optcomp ppx_diff.ppx_diff)) 27 | (preprocessor_deps config.h gc_stubs.h) 28 | (js_of_ocaml 29 | (javascript_files strftime.js runtime.js 30 | temporal-polyfill/temporal-polyfill.js timezone_js_loader_stubs.js 31 | timezone_runtime.js)) 32 | (wasm_of_ocaml 33 | (javascript_files strftime.js runtime.js 34 | temporal-polyfill/temporal-polyfill.js timezone_js_loader_stubs.js 35 | timezone_runtime.js) 36 | (wasm_files runtime.wat timezone_js_loader_stubs.wasm.js 37 | timezone_js_loader_stubs.wat))) 38 | 39 | (rule 40 | (targets gc_stubs.h) 41 | (deps) 42 | (action 43 | (bash "echo \"#define OCAML_5_MINUS false\" > %{targets}"))) 44 | 45 | (documentation) 46 | 47 | (rule 48 | (targets ocamlopt-flags) 49 | (deps) 50 | (action 51 | (bash "echo '()' > ocamlopt-flags"))) 52 | -------------------------------------------------------------------------------- /core/src/either.ml: -------------------------------------------------------------------------------- 1 | module Stable = struct 2 | module V1 = struct 3 | type ('f, 's) t = ('f, 's) Base.Either.t = 4 | | First of 'f 5 | | Second of 's 6 | [@@deriving 7 | bin_io ~localize 8 | , compare ~localize 9 | , equal ~localize 10 | , hash 11 | , sexp 12 | , sexp_grammar 13 | , stable_witness 14 | , typerep] 15 | 16 | let map x ~f1 ~f2 = 17 | match x with 18 | | First x1 -> First (f1 x1) 19 | | Second x2 -> Second (f2 x2) 20 | ;; 21 | end 22 | end 23 | 24 | include Stable.V1 25 | include Base.Either 26 | 27 | include%template Comparator.Derived2 [@modality portable] (struct 28 | type nonrec ('a, 'b) t = ('a, 'b) t [@@deriving sexp_of, compare ~localize] 29 | end) 30 | 31 | let quickcheck_generator = Base_quickcheck.Generator.either 32 | let quickcheck_observer = Base_quickcheck.Observer.either 33 | let quickcheck_shrinker = Base_quickcheck.Shrinker.either 34 | -------------------------------------------------------------------------------- /core/src/either.mli: -------------------------------------------------------------------------------- 1 | (** This module extends {{!Base.Either} [Base.Either]}. *) 2 | 3 | type ('f, 's) t = ('f, 's) Base.Either.t = 4 | | First of 'f 5 | | Second of 's 6 | [@@deriving bin_io ~localize, typerep] 7 | 8 | (** @inline *) 9 | include module type of struct 10 | include Base.Either 11 | end 12 | with type ('f, 's) t := ('f, 's) t 13 | 14 | include Comparator.Derived2 with type ('a, 'b) t := ('a, 'b) t 15 | include Quickcheckable.S2 with type ('a, 'b) t := ('a, 'b) t 16 | 17 | module Stable : sig 18 | module V1 : sig 19 | type nonrec ('f, 's) t = ('f, 's) t = 20 | | First of 'f 21 | | Second of 's 22 | [@@deriving bin_io ~localize, equal ~localize, sexp_grammar] 23 | 24 | include%template 25 | Stable_module_types.With_stable_witness.S2 26 | [@mode local] 27 | with type ('f, 's) t := ('f, 's) t 28 | end 29 | end 30 | -------------------------------------------------------------------------------- /core/src/error.ml: -------------------------------------------------------------------------------- 1 | include Base.Error 2 | include Info.Extend (Base.Error) 3 | 4 | let failwiths ?strict ?(here = Stdlib.Lexing.dummy_pos) message a sexp_of_a = 5 | let here = if Source_code_position0.is_dummy here then None else Some here in 6 | raise (create ?strict ?here message a sexp_of_a) 7 | ;; 8 | 9 | let failwithp ?strict here message a sexp_of_a = 10 | raise (create ?strict ~here message a sexp_of_a) 11 | ;; 12 | -------------------------------------------------------------------------------- /core/src/error.mli: -------------------------------------------------------------------------------- 1 | (** This module extends {{!module:Base.Error} [Base.Error]} with [bin_io], [diff], and 2 | [quickcheck]. *) 3 | 4 | open! Import 5 | 6 | (** @inline *) 7 | include module type of struct 8 | include Base.Error 9 | end 10 | 11 | include Quickcheckable.S with type t := t 12 | 13 | (** This include is the source of the bin_io and diff functions. *) 14 | include Info_intf.Extension with type t := t 15 | 16 | (** @inline *) 17 | 18 | (** [Error.t] is {e not} wire-compatible with [Error.Stable.V1.t]. See info.mli for 19 | details. *) 20 | 21 | (** {[ 22 | failwiths ?strict ~here message a sexp_of_a 23 | = Error.raise (Error.create ?strict ~here s a sexp_of_a) 24 | ]} 25 | 26 | As with [Error.create], [sexp_of_a a] is lazily computed when the error is converted 27 | to a sexp. So if [a] is mutated in the time between the call to [failwiths] and the 28 | sexp conversion, those mutations will be reflected in the error message. Use 29 | [~strict:()] to force [sexp_of_a a] to be computed immediately. 30 | 31 | In this signature we write [~here:Lexing.position] rather than 32 | [~here:Source_code_position.t] to avoid a circular dependency. *) 33 | val failwiths 34 | : ?strict:unit 35 | -> ?here:Stdlib.Lexing.position 36 | -> string 37 | -> 'a 38 | -> ('a -> Base.Sexp.t) 39 | -> _ 40 | 41 | val failwithp 42 | : ?strict:unit 43 | -> Lexing.position 44 | -> string 45 | -> 'a 46 | -> ('a -> Base.Sexp.t) 47 | -> _ 48 | [@@deprecated "[since 2020-03] Use [failwiths] instead."] 49 | -------------------------------------------------------------------------------- /core/src/filename.ml: -------------------------------------------------------------------------------- 1 | module Stable = struct 2 | module V1 = struct 3 | include ( 4 | String.Stable.V1 : 5 | sig 6 | type t = string 7 | [@@deriving 8 | bin_io ~localize 9 | , compare ~localize 10 | , equal ~localize 11 | , hash 12 | , sexp 13 | , sexp_grammar 14 | , stable_witness] 15 | 16 | include 17 | Comparable.Stable.V1.With_stable_witness.S 18 | with type comparable := t 19 | with type comparator_witness = String.Stable.V1.comparator_witness 20 | 21 | val comparator : (t, comparator_witness) Comparator.t 22 | 23 | include Hashable.Stable.V1.With_stable_witness.S with type key := t 24 | end) 25 | end 26 | end 27 | 28 | open! Import 29 | open! Std_internal 30 | include Filename_base 31 | 32 | include ( 33 | String : 34 | sig 35 | type t = string [@@deriving bin_io ~localize] 36 | 37 | include%template 38 | Comparable.S 39 | [@mode local] 40 | with type t := t 41 | and type comparator_witness := comparator_witness 42 | 43 | include Hashable.S with type t := t 44 | end) 45 | -------------------------------------------------------------------------------- /core/src/filename.mli: -------------------------------------------------------------------------------- 1 | open! Import 2 | open! Std_internal 3 | include module type of Filename_base 4 | 5 | include%template Binable.S [@mode local] with type t := t 6 | 7 | include%template 8 | Comparable.S 9 | [@mode local] 10 | with type t := t 11 | and type comparator_witness := comparator_witness 12 | 13 | include Hashable.S with type t := t 14 | 15 | module Stable : sig 16 | module V1 : sig 17 | type nonrec t = t [@@deriving bin_io ~localize, equal ~localize, hash, sexp_grammar] 18 | 19 | include%template 20 | Stable_comparable.With_stable_witness.V1 21 | [@mode local] 22 | with type t := t 23 | with type comparator_witness = comparator_witness 24 | 25 | include Hashable.Stable.V1.With_stable_witness.S with type key := t 26 | end 27 | end 28 | -------------------------------------------------------------------------------- /core/src/float_with_finite_only_serialization.ml: -------------------------------------------------------------------------------- 1 | open Ppx_compare_lib.Builtin 2 | 3 | module Stable = struct 4 | open Stable_internal 5 | module Binable = Binable.Stable 6 | 7 | module V1 = struct 8 | exception Nan_or_inf [@@deriving sexp] 9 | 10 | type t = float [@@deriving compare ~localize, hash, equal ~localize, stable_witness] 11 | 12 | let verify t = 13 | match Float.classify t with 14 | | Normal | Subnormal | Zero -> () 15 | | Infinite | Nan -> raise Nan_or_inf 16 | ;; 17 | 18 | include%template 19 | Binable.Of_binable.V1 [@mode local] [@modality portable] [@alert "-legacy"] 20 | (Float) 21 | (struct 22 | type nonrec t = t 23 | 24 | let of_binable t = 25 | verify t; 26 | t 27 | ;; 28 | 29 | let%template to_binable t = 30 | verify t; 31 | t 32 | [@@mode m = (global, local)] 33 | ;; 34 | end) 35 | 36 | let sexp_of_t = Float.sexp_of_t 37 | 38 | let t_of_sexp = function 39 | | Sexp.Atom _ as sexp -> 40 | let t = Float.t_of_sexp sexp in 41 | (try verify t with 42 | | e -> Import.of_sexp_error (Import.Exn.to_string e) sexp); 43 | t 44 | | s -> Import.of_sexp_error "Decimal.t_of_sexp: Expected Atom, found List" s 45 | ;; 46 | 47 | let t_sexp_grammar = Float.t_sexp_grammar 48 | end 49 | end 50 | 51 | include Stable.V1 52 | -------------------------------------------------------------------------------- /core/src/float_with_finite_only_serialization.mli: -------------------------------------------------------------------------------- 1 | (** An alias to the [Float.t] type that causes the sexp and bin-io serializers to fail 2 | when provided with [nan] or [infinity]. 3 | 4 | Note that while it makes sense to use this on the definition of a type in the ml file, 5 | where it will influence the construction of the sexp and bin-io serializers, it does 6 | {e not} make sense to use this in an mli, since it makes no guarantee at that level. *) 7 | 8 | open! Import 9 | 10 | type t = float 11 | [@@deriving 12 | bin_io ~localize, sexp, sexp_grammar, compare ~localize, hash, equal ~localize] 13 | 14 | module Stable : sig 15 | module V1 : sig 16 | type nonrec t = t 17 | [@@deriving 18 | bin_io, sexp, sexp_grammar, compare ~localize, hash, equal ~localize, stable_witness] 19 | end 20 | end 21 | -------------------------------------------------------------------------------- /core/src/fn.ml: -------------------------------------------------------------------------------- 1 | (** Extends {{!Base.Fn} [Base.Fn]}. *) 2 | 3 | include Base.Fn (** @open *) 4 | 5 | include Deprecate_pipe_bang 6 | -------------------------------------------------------------------------------- /core/src/fn.mli: -------------------------------------------------------------------------------- 1 | open! Import 2 | 3 | include module type of struct 4 | include Base.Fn 5 | end 6 | 7 | include module type of struct 8 | include Deprecate_pipe_bang 9 | end 10 | -------------------------------------------------------------------------------- /core/src/fqueue.ml: -------------------------------------------------------------------------------- 1 | open! Import 2 | include Fdeque 3 | 4 | let enqueue = enqueue_back 5 | let peek_exn = peek_front_exn 6 | let peek = peek_front 7 | let dequeue_exn = dequeue_front_exn 8 | let dequeue = dequeue_front 9 | let drop_exn = drop_front_exn 10 | let to_sequence = Front_to_back.to_sequence 11 | let of_sequence = Front_to_back.of_sequence 12 | 13 | (* Deprecated aliases *) 14 | let top = peek 15 | let top_exn = peek_exn 16 | let discard_exn = drop_exn 17 | -------------------------------------------------------------------------------- /core/src/hash_queue.mli: -------------------------------------------------------------------------------- 1 | include Hash_queue_intf.Hash_queue (** @inline *) 2 | -------------------------------------------------------------------------------- /core/src/hash_set.mli: -------------------------------------------------------------------------------- 1 | include Hash_set_intf.Hash_set 2 | -------------------------------------------------------------------------------- /core/src/hashable.mli: -------------------------------------------------------------------------------- 1 | include Hashable_intf.Hashable 2 | -------------------------------------------------------------------------------- /core/src/hashtbl.mli: -------------------------------------------------------------------------------- 1 | open! Import 2 | 3 | include%template 4 | Hashtbl_intf.Hashtbl [@modality portable] with type ('a, 'b) t = ('a, 'b) Base.Hashtbl.t 5 | (** @inline *) 6 | -------------------------------------------------------------------------------- /core/src/hexdump.mli: -------------------------------------------------------------------------------- 1 | include Hexdump_intf.Hexdump (** @inline *) 2 | -------------------------------------------------------------------------------- /core/src/host_and_port.mli: -------------------------------------------------------------------------------- 1 | (** Type for the commonly-used notion of host and port in networking. *) 2 | 3 | open! Std_internal 4 | 5 | type t = 6 | { host : string 7 | ; port : int 8 | } 9 | [@@deriving hash] 10 | 11 | val create : host:string -> port:int -> t 12 | val host : t -> string 13 | val port : t -> int 14 | val tuple : t -> string * int 15 | 16 | include%template Comparator.S [@modality portable] with type t := t 17 | 18 | include%template 19 | Identifiable.S 20 | [@mode local] 21 | with type t := t 22 | and type comparator_witness := comparator_witness 23 | 24 | include Sexplib.Sexp_grammar.S with type t := t 25 | 26 | module Hide_port_in_test : sig 27 | include%template 28 | Identifiable.S 29 | [@mode local] 30 | with type t = t 31 | and type comparator_witness = comparator_witness 32 | end 33 | 34 | module Stable : sig 35 | module V1 : sig 36 | type nonrec t = t 37 | [@@deriving 38 | sexp, sexp_grammar, bin_io, compare ~localize, equal ~localize, hash, quickcheck] 39 | 40 | include Base.Stringable.S with type t := t 41 | 42 | include%template 43 | Stable_comparable.With_stable_witness.V1 44 | [@mode local] 45 | with type t := t 46 | and type comparator_witness = comparator_witness 47 | end 48 | end 49 | 50 | val type_id : t Type_equal.Id.t 51 | -------------------------------------------------------------------------------- /core/src/iarray.ml: -------------------------------------------------------------------------------- 1 | open! Import 2 | include Base.Iarray 3 | 4 | module Stable = struct 5 | module V1 = struct 6 | type nonrec 'a t = 'a t 7 | [@@deriving compare ~localize, equal ~localize, globalize, hash] 8 | 9 | let map = map 10 | 11 | include%template 12 | Sexpable.Stable.Of_sexpable1.V1 [@modality portable] 13 | (struct 14 | type 'a t = 'a array [@@deriving sexp] 15 | end) 16 | (struct 17 | type nonrec 'a t = 'a t 18 | 19 | let to_sexpable = unsafe_to_array__promise_no_mutation 20 | let of_sexpable = unsafe_of_array__promise_no_mutation 21 | end) 22 | 23 | let t_sexp_grammar (type a) (a_sexp_grammar : a Sexplib.Sexp_grammar.t) = 24 | Sexplib.Sexp_grammar.coerce [%sexp_grammar: a array] 25 | ;; 26 | 27 | [%%rederive type 'a t = 'a iarray [@@deriving bin_io ~localize ~portable]] 28 | 29 | let stable_witness elt_witness = 30 | Stable_witness.of_serializable 31 | (stable_witness_array elt_witness) 32 | unsafe_of_array__promise_no_mutation 33 | unsafe_to_array__promise_no_mutation 34 | ;; 35 | end 36 | end 37 | 38 | include struct 39 | open Base_quickcheck 40 | 41 | let quickcheck_generator elt_generator = 42 | Generator.list elt_generator |> Generator.map ~f:of_list 43 | ;; 44 | 45 | let quickcheck_observer elt_observer = 46 | Observer.list elt_observer |> Observer.unmap ~f:to_list 47 | ;; 48 | 49 | let quickcheck_shrinker elt_shrinker = 50 | Shrinker.list elt_shrinker |> Shrinker.map ~f:of_list ~f_inverse:to_list 51 | ;; 52 | end 53 | 54 | include ( 55 | struct 56 | type nonrec 'a t = 'a t [@@deriving typerep ~abstract] 57 | end : 58 | Typerep_lib.Typerepable.S1 with type 'a t := 'a t) 59 | 60 | include Stable.V1 61 | -------------------------------------------------------------------------------- /core/src/iarray.mli: -------------------------------------------------------------------------------- 1 | open! Import 2 | 3 | type 'a t = 'a Base.Iarray.t [@@deriving bin_io ~localize, quickcheck, typerep] 4 | 5 | include Base.Iarray.Public with type 'a t := 'a t (** @inline *) 6 | 7 | module Stable : sig 8 | module V1 : sig 9 | type nonrec 'a t = 'a t 10 | [@@deriving compare ~localize, equal ~localize, globalize, hash, sexp, sexp_grammar] 11 | 12 | include%template 13 | Stable_module_types.With_stable_witness.S1 [@mode local] with type 'a t := 'a t 14 | end 15 | end 16 | -------------------------------------------------------------------------------- /core/src/identifiable.mli: -------------------------------------------------------------------------------- 1 | include Identifiable_intf.Identifiable (** @inline *) 2 | -------------------------------------------------------------------------------- /core/src/immediate_option.ml: -------------------------------------------------------------------------------- 1 | include Immediate_option_intf 2 | -------------------------------------------------------------------------------- /core/src/immediate_option.mli: -------------------------------------------------------------------------------- 1 | include Immediate_option_intf.Immediate_option (** @inline *) 2 | -------------------------------------------------------------------------------- /core/src/index.mld: -------------------------------------------------------------------------------- 1 | {0 Core} 2 | 3 | {b {{!Core} The full API is browsable here}}. 4 | 5 | {!Core} is an industrial-strength alternative to the OCaml standard library. It 6 | was developed by Jane Street, which is the largest industrial user of OCaml. 7 | Core works with Javascript. It provides an overlay on the usual namespace, so 8 | the best way to use it is to start your file with: 9 | 10 | {[open! Core]} 11 | 12 | {1 Relationship between Core and Base} 13 | 14 | In sum: 15 | 16 | - {b {!Base}}: Minimal stdlib replacement. Portable and lightweight and 17 | intended to be highly stable. 18 | 19 | - {b {!Core}}: Extension of Base. More fully featured, with more 20 | code and dependencies, and APIs that evolve more quickly. Portable, 21 | and works on Javascript. 22 | 23 | Many of Core's modules are extensions of modules in Base, where the 24 | Core version adds bin_io support or locks in an API with Stable. Some 25 | modules, like {{!Core.Map} Map}, extend their Base equivalents to 26 | follow Core conventions for the use of comparators. 27 | -------------------------------------------------------------------------------- /core/src/indexed_container.ml: -------------------------------------------------------------------------------- 1 | include Base.Indexed_container 2 | include Indexed_container_intf 3 | -------------------------------------------------------------------------------- /core/src/indexed_container.mli: -------------------------------------------------------------------------------- 1 | include Indexed_container_intf.Indexed_container 2 | -------------------------------------------------------------------------------- /core/src/info.mli: -------------------------------------------------------------------------------- 1 | (** This module extends {{!Base.Info} [Base.Info]}, which provides a type for info-level 2 | debug messages. *) 3 | 4 | include Info_intf.Info (** @inline *) 5 | -------------------------------------------------------------------------------- /core/src/info_intf.ml: -------------------------------------------------------------------------------- 1 | open! Import 2 | 3 | (** Extension to the base signature *) 4 | module type Extension = sig 5 | type t 6 | [@@deriving 7 | bin_io ~localize, diff ~how:"atomic" ~extra_derive:[ sexp ], globalize, quickcheck] 8 | 9 | module Stable : sig 10 | (** [Info.t] is wire-compatible with [V2.t], but not [V1.t]. [V1] bin-prots a sexp of 11 | the underlying message, whereas [V2] bin-prots the underlying message. *) 12 | module%template V1 : 13 | Stable_module_types.With_stable_witness.S0 [@mode local] with type t = t 14 | 15 | module V2 : sig 16 | type nonrec t = t 17 | [@@deriving 18 | globalize 19 | , equal ~localize 20 | , hash 21 | , sexp_grammar 22 | , diff ~extra_derive:[ sexp; bin_io ]] 23 | 24 | include%template 25 | Stable_module_types.With_stable_witness.S0 [@mode local] with type t := t 26 | end 27 | end 28 | end 29 | 30 | module type Info = sig 31 | module type S = Base.Info.S 32 | 33 | include S with type t = Base.Info.t (** @inline *) 34 | 35 | module Internal_repr : Base.Info.Internal_repr with type info := t 36 | include Extension with type t := t 37 | module Extend (Info : Base.Info.S) : Extension with type t := Info.t 38 | end 39 | -------------------------------------------------------------------------------- /core/src/int.ml: -------------------------------------------------------------------------------- 1 | open! Import 2 | 3 | module Stable = struct 4 | module V1 = struct 5 | module T = struct 6 | include Base.Int 7 | 8 | type t = int [@@deriving bin_io ~localize, hash, sexp, stable_witness] 9 | end 10 | 11 | include T 12 | 13 | include%template Comparable.Stable.V1.With_stable_witness.Make [@modality portable] (T) 14 | end 15 | end 16 | 17 | module Binable = struct 18 | type t = int [@@deriving bin_io ~localize] 19 | end 20 | 21 | include Binable 22 | 23 | include%template Identifiable.Extend [@modality portable] (Base.Int) (Binable) 24 | 25 | module Replace_polymorphic_compare = Base.Int 26 | include Base.Int 27 | 28 | include%template Comparable.Validate_with_zero [@modality portable] (Base.Int) 29 | 30 | (* This is already defined by Comparable.Validate_with_zero, but Sign.of_int is 31 | more direct. *) 32 | let sign = Sign.of_int 33 | 34 | type t = int [@@deriving typerep] 35 | 36 | module Binary = struct 37 | include Binary 38 | 39 | type nonrec t = t [@@deriving typerep, bin_io ~localize] 40 | end 41 | 42 | module Hex = struct 43 | include Hex 44 | 45 | type nonrec t = t [@@deriving typerep, bin_io ~localize] 46 | end 47 | 48 | let quickcheck_generator = Base_quickcheck.Generator.int 49 | let quickcheck_observer = Base_quickcheck.Observer.int 50 | let quickcheck_shrinker = Base_quickcheck.Shrinker.int 51 | let gen_incl = Base_quickcheck.Generator.int_inclusive 52 | let gen_uniform_incl = Base_quickcheck.Generator.int_uniform_inclusive 53 | let gen_log_incl = Base_quickcheck.Generator.int_log_inclusive 54 | let gen_log_uniform_incl = Base_quickcheck.Generator.int_log_uniform_inclusive 55 | -------------------------------------------------------------------------------- /core/src/int.mli: -------------------------------------------------------------------------------- 1 | (** This module extends {{!Base.Int} [Base.Int]}. *) 2 | 3 | include 4 | Base.Int.Int_without_module_types 5 | with type comparator_witness = Base.Int.comparator_witness 6 | (** @inline *) 7 | 8 | (** Note that [int] is already stable by itself, since as a primitive type it is an 9 | integral part of the sexp / bin_io protocol. [Int.Stable] exists only to introduce 10 | [Int.Stable.Set] and [Int.Stable.Map], and provide interface uniformity with other 11 | stable types. *) 12 | 13 | include 14 | Int_intf.Extension_with_stable 15 | with type t := t 16 | and type comparator_witness := comparator_witness 17 | 18 | include sig 19 | type nonrec t = t [@@deriving bin_io ~localize] 20 | end 21 | -------------------------------------------------------------------------------- /core/src/int32.ml: -------------------------------------------------------------------------------- 1 | open! Import 2 | 3 | module Binable = struct 4 | type t = int32 [@@deriving bin_io ~localize] 5 | end 6 | 7 | include Binable 8 | 9 | include%template 10 | Identifiable.Extend [@mode local] [@modality portable] (Base.Int32) (Binable) 11 | 12 | include Base.Int32 13 | 14 | include%template Comparable.Validate_with_zero [@modality portable] (Base.Int32) 15 | 16 | type t = int32 [@@deriving typerep] 17 | 18 | module Binary = struct 19 | include Binary 20 | 21 | type nonrec t = t [@@deriving typerep, bin_io ~localize] 22 | end 23 | 24 | module Hex = struct 25 | include Hex 26 | 27 | type nonrec t = t [@@deriving typerep, bin_io ~localize] 28 | end 29 | 30 | let quickcheck_generator = Base_quickcheck.Generator.int32 31 | let quickcheck_observer = Base_quickcheck.Observer.int32 32 | let quickcheck_shrinker = Base_quickcheck.Shrinker.int32 33 | let gen_incl = Base_quickcheck.Generator.int32_inclusive 34 | let gen_uniform_incl = Base_quickcheck.Generator.int32_uniform_inclusive 35 | let gen_log_incl = Base_quickcheck.Generator.int32_log_inclusive 36 | let gen_log_uniform_incl = Base_quickcheck.Generator.int32_log_uniform_inclusive 37 | -------------------------------------------------------------------------------- /core/src/int32.mli: -------------------------------------------------------------------------------- 1 | (** This module extends {{!Base.Int32} [Base.Int32]}. *) 2 | 3 | (** {2 Interface from Base} *) 4 | 5 | (** @inline *) 6 | include module type of struct 7 | include Base.Int32 8 | end 9 | 10 | (** {2 Extensions} *) 11 | 12 | (** @inline *) 13 | include 14 | Int_intf.Extension with type t := t and type comparator_witness := comparator_witness 15 | 16 | include sig 17 | type nonrec t = t [@@deriving bin_io ~localize] 18 | end 19 | -------------------------------------------------------------------------------- /core/src/int63.mli: -------------------------------------------------------------------------------- 1 | (** This module extends {{!Base.Int63} [Base.Int63]}. *) 2 | 3 | (** {2 Interface from Base} *) 4 | 5 | (** @inline *) 6 | include module type of struct 7 | include Base.Int63 8 | end 9 | 10 | (** {2 Extensions} *) 11 | 12 | (** @inline *) 13 | include 14 | Int_intf.Extension with type t := t and type comparator_witness := comparator_witness 15 | 16 | module Stable : sig 17 | module V1 : sig 18 | type nonrec t = t 19 | [@@deriving 20 | bin_io ~localize ~portable 21 | , compare ~localize ~portable 22 | , equal ~localize ~portable 23 | , globalize 24 | , hash 25 | , sexp_grammar] 26 | [@@immediate64] 27 | 28 | include 29 | Stable_comparable.With_stable_witness.V1 30 | with type t := t 31 | and type comparator_witness = comparator_witness 32 | end 33 | end 34 | -------------------------------------------------------------------------------- /core/src/int64.ml: -------------------------------------------------------------------------------- 1 | open! Import 2 | 3 | module Binable = struct 4 | type t = int64 [@@deriving bin_io ~localize] 5 | end 6 | 7 | include Binable 8 | 9 | include%template 10 | Identifiable.Extend [@mode local] [@modality portable] (Base.Int64) (Binable) 11 | 12 | include Base.Int64 13 | 14 | include%template Comparable.Validate_with_zero [@modality portable] (Base.Int64) 15 | 16 | type t = int64 [@@deriving typerep] 17 | 18 | module Binary = struct 19 | include Binary 20 | 21 | type nonrec t = t [@@deriving typerep, bin_io ~localize] 22 | end 23 | 24 | module Hex = struct 25 | include Hex 26 | 27 | type nonrec t = t [@@deriving typerep, bin_io ~localize] 28 | end 29 | 30 | let quickcheck_generator = Base_quickcheck.Generator.int64 31 | let quickcheck_observer = Base_quickcheck.Observer.int64 32 | let quickcheck_shrinker = Base_quickcheck.Shrinker.int64 33 | let gen_incl = Base_quickcheck.Generator.int64_inclusive 34 | let gen_uniform_incl = Base_quickcheck.Generator.int64_uniform_inclusive 35 | let gen_log_incl = Base_quickcheck.Generator.int64_log_inclusive 36 | let gen_log_uniform_incl = Base_quickcheck.Generator.int64_log_uniform_inclusive 37 | -------------------------------------------------------------------------------- /core/src/int64.mli: -------------------------------------------------------------------------------- 1 | (** This module extends {{!Base.Int64} [Base.Int64]}. *) 2 | 3 | (** {2 Interface from Base} *) 4 | 5 | (** @inline *) 6 | include module type of struct 7 | include Base.Int64 8 | end 9 | 10 | (** {2 Extensions} *) 11 | 12 | (** @inline *) 13 | include 14 | Int_intf.Extension with type t := t and type comparator_witness := comparator_witness 15 | 16 | include sig 17 | type nonrec t = t [@@deriving bin_io ~localize] 18 | end 19 | -------------------------------------------------------------------------------- /core/src/lazy.ml: -------------------------------------------------------------------------------- 1 | open! Import 2 | open Base_quickcheck.Export 3 | 4 | module Stable = struct 5 | module V1 = struct 6 | open Sexplib.Std 7 | 8 | type 'a t = 'a lazy_t 9 | [@@deriving 10 | bin_io ~localize, quickcheck, sexp ~localize, sexp_grammar, typerep, stable_witness] 11 | 12 | let map = Base.Lazy.map 13 | let compare = Base.Lazy.compare 14 | let compare__local = Base.Lazy.compare__local 15 | let equal = Base.Lazy.equal 16 | let equal__local = Base.Lazy.equal__local 17 | end 18 | end 19 | 20 | module type Base_mask = module type of Base.Lazy with type 'a t := 'a Stable.V1.t 21 | 22 | include Stable.V1 23 | include (Base.Lazy : Base_mask) 24 | -------------------------------------------------------------------------------- /core/src/lazy.mli: -------------------------------------------------------------------------------- 1 | (** This module extends {{!Base.Lazy} [Base.Lazy]}. *) 2 | 3 | open! Import 4 | 5 | type 'a t = 'a Base.Lazy.t 6 | [@@deriving 7 | bin_io ~localize 8 | , compare ~localize 9 | , hash 10 | , quickcheck 11 | , sexp ~localize 12 | , sexp_grammar 13 | , typerep] 14 | 15 | include module type of Base.Lazy with type 'a t := 'a t (** @inline *) 16 | 17 | module Stable : sig 18 | module V1 : sig 19 | type nonrec 'a t = 'a t 20 | [@@deriving bin_io ~localize, compare ~localize, equal ~localize, sexp_grammar] 21 | 22 | include%template 23 | Stable_module_types.With_stable_witness.S1 [@mode local] with type 'a t := 'a t 24 | end 25 | end 26 | -------------------------------------------------------------------------------- /core/src/linked_queue.ml: -------------------------------------------------------------------------------- 1 | open! Import 2 | module Queue = Base.Linked_queue 3 | include Queue 4 | 5 | include%template Bin_prot.Utils.Make_iterable_binable1 [@modality portable] (struct 6 | type 'a t = 'a Queue.t 7 | type 'a el = 'a [@@deriving bin_io] 8 | 9 | let caller_identity = 10 | Bin_prot.Shape.Uuid.of_string "800df9a0-4992-11e6-881d-ffe1a5c8aced" 11 | ;; 12 | 13 | let module_name = Some "Core.Linked_queue" 14 | let length = length 15 | let iter = iter 16 | 17 | (* Bin_prot reads the elements in the same order they were written out, as determined 18 | by [iter]. So, we can ignore the index and just enqueue each element as it is read 19 | in. *) 20 | let init ~len ~next = 21 | let t = create () in 22 | for _ = 1 to len do 23 | enqueue t (next ()) 24 | done; 25 | t 26 | ;; 27 | end) 28 | 29 | include%template 30 | Quickcheckable.Of_quickcheckable1 [@modality portable] 31 | (List) 32 | (struct 33 | type nonrec 'a t = 'a t 34 | 35 | let to_quickcheckable = to_list 36 | let of_quickcheckable = of_list 37 | end) 38 | -------------------------------------------------------------------------------- /core/src/linked_queue.mli: -------------------------------------------------------------------------------- 1 | (** This module extends the {{!Base.Linked_queue} [Base.Linked_queue]} module with bin_io 2 | support. As a reminder, the [Base.Linked_queue] module is a wrapper around OCaml's 3 | standard [Queue] module that follows Base idioms and adds some functions. 4 | 5 | See also {!Core.Queue}, which has different performance characteristics. *) 6 | 7 | type 'a t = 'a Base.Linked_queue.t [@@deriving bin_io, quickcheck] 8 | 9 | (** @inline *) 10 | include module type of struct 11 | include Base.Linked_queue 12 | end 13 | with type 'a t := 'a t 14 | -------------------------------------------------------------------------------- /core/src/list.ml: -------------------------------------------------------------------------------- 1 | include List0 (** @inline *) 2 | 3 | let zip_with_remainder = 4 | let rec zip_with_acc_and_remainder acc xs ys = 5 | match xs, ys with 6 | | [], [] -> rev acc, None 7 | | fst, [] -> rev acc, Some (Either.First fst) 8 | | [], snd -> rev acc, Some (Either.Second snd) 9 | | x :: xs, y :: ys -> zip_with_acc_and_remainder ((x, y) :: acc) xs ys 10 | in 11 | fun xs ys -> zip_with_acc_and_remainder [] xs ys 12 | ;; 13 | 14 | type sexp_thunk = unit -> Base.Sexp.t 15 | 16 | let sexp_of_sexp_thunk x = x () 17 | 18 | exception Duplicate_found of sexp_thunk * Base.String.t [@@deriving sexp] 19 | 20 | let exn_if_dup ~compare ?(context = "exn_if_dup") t ~to_sexp = 21 | match find_a_dup ~compare t with 22 | | None -> () 23 | | Some dup -> raise (Duplicate_found ((fun () -> to_sexp dup), context)) 24 | ;; 25 | 26 | let slice a start stop = 27 | Ordered_collection_common.slice ~length_fun:(length :> _ -> _) ~sub_fun:sub a start stop 28 | ;; 29 | 30 | module Stable = struct 31 | module V1 = struct 32 | type%template nonrec 'a t = ('a t[@kind k]) 33 | [@@kind k = (float64, bits32, bits64, word)] 34 | [@@deriving compare ~localize, equal ~localize] 35 | 36 | type nonrec 'a t = 'a t 37 | [@@deriving 38 | sexp, sexp_grammar, bin_io ~localize, compare ~localize, equal ~localize, hash] 39 | 40 | let stable_witness = List0.stable_witness [@@alert "-for_internal_use_only"] 41 | end 42 | end 43 | -------------------------------------------------------------------------------- /core/src/list0.ml: -------------------------------------------------------------------------------- 1 | open! Import 2 | open! Typerep_lib.Std 3 | include Base.List 4 | 5 | [%%rederive.portable 6 | type 'a t = 'a list [@@deriving bin_io ~localize, typerep, stable_witness]] 7 | 8 | module Assoc = struct 9 | include Assoc 10 | 11 | type ('a, 'b) t = ('a * 'b) list [@@deriving bin_io ~localize] 12 | 13 | let compare (type a b) compare_a compare_b = [%compare: (a * b) list] 14 | end 15 | 16 | let to_string ~f t = 17 | Sexplib.Sexp.to_string (sexp_of_t (fun x -> Sexplib.Sexp.Atom x) (map t ~f)) 18 | ;; 19 | 20 | include%template Comparator.Derived [@modality portable] (struct 21 | type nonrec 'a t = 'a t [@@deriving sexp_of, compare ~localize] 22 | end) 23 | 24 | [%%template 25 | [@@@mode.default p = (nonportable, portable)] 26 | 27 | let quickcheck_generator = (Base_quickcheck.Generator.list [@mode p]) 28 | let quickcheck_observer = (Base_quickcheck.Observer.list [@mode p]) 29 | let quickcheck_shrinker = (Base_quickcheck.Shrinker.list [@mode p])] 30 | 31 | let gen_non_empty = Base_quickcheck.Generator.list_non_empty 32 | 33 | let gen_with_length length quickcheck_generator = 34 | Base_quickcheck.Generator.list_with_length quickcheck_generator ~length 35 | ;; 36 | 37 | let gen_filtered = Base_quickcheck.Generator.list_filtered 38 | let gen_permutations = Base_quickcheck.Generator.list_permutations 39 | -------------------------------------------------------------------------------- /core/src/list0.mli: -------------------------------------------------------------------------------- 1 | open! Import 2 | 3 | include module type of struct 4 | include Base.List 5 | end 6 | 7 | [%%rederive: type 'a t = 'a Base.List.t [@@deriving bin_io ~localize, typerep]] 8 | include%template Comparator.Derived [@modality portable] with type 'a t := 'a t 9 | include%template Quickcheckable.S1 [@mode portable] with type 'a t := 'a t 10 | 11 | val stable_witness : 'a Stable_witness.t -> 'a t Stable_witness.t 12 | [@@alert 13 | for_internal_use_only 14 | "[Core.List0.stable_witness] is only exported for use in [Core.List.Stable]"] 15 | 16 | val to_string : f:('a -> string) -> 'a t -> string 17 | val gen_non_empty : 'a Quickcheck.Generator.t -> 'a t Quickcheck.Generator.t 18 | val gen_with_length : int -> 'a Quickcheck.Generator.t -> 'a t Quickcheck.Generator.t 19 | val gen_filtered : 'a t -> 'a t Quickcheck.Generator.t 20 | val gen_permutations : 'a t -> 'a t Quickcheck.Generator.t 21 | 22 | module Assoc : sig 23 | include module type of struct 24 | include Base.List.Assoc 25 | end 26 | 27 | type ('a, 'b) t = ('a, 'b) Base.List.Assoc.t [@@deriving bin_io ~localize] 28 | 29 | val compare : ('a -> 'a -> int) -> ('b -> 'b -> int) -> ('a, 'b) t -> ('a, 'b) t -> int 30 | [@@deprecated 31 | "[since 2016-06] This does not respect the equivalence class promised by List.Assoc. \ 32 | Use List.compare directly if that's what you want."] 33 | end 34 | -------------------------------------------------------------------------------- /core/src/make_substring.mli: -------------------------------------------------------------------------------- 1 | include Make_substring_intf.Make_substring 2 | -------------------------------------------------------------------------------- /core/src/make_substring_intf.ml: -------------------------------------------------------------------------------- 1 | open! Import 2 | 3 | module type Base = sig 4 | type t [@@deriving quickcheck] 5 | 6 | val create : int -> t 7 | val length : t -> int 8 | val blit : (t, t) Blit.blito 9 | val blit_to_bytes : (t, bytes) Blit.blito 10 | val blit_to_bigstring : (t, bigstring) Blit.blito 11 | val blit_from_string : (string, t) Blit.blito 12 | val blit_from_bigstring : (bigstring, t) Blit.blito 13 | 14 | val blit_to_string : (t, bytes) Blit.blito 15 | [@@deprecated "[since 2017-10] use [blit_to_bytes] instead"] 16 | 17 | val get : t -> int -> char 18 | end 19 | 20 | module type S = Substring_intf.S 21 | 22 | module type Make_substring = sig 23 | module type Base = Base 24 | module type S = S 25 | 26 | type bigstring = Bigstring.t 27 | 28 | module Blit : sig 29 | type ('src, 'dst) t = ('src, 'dst) Blit.blito 30 | 31 | val string_string : (string, bytes) t 32 | [@@deprecated "[since 2017-10] use [string_bytes] instead"] 33 | 34 | val bigstring_string : (bigstring, bytes) t 35 | [@@deprecated "[since 2017-10] use [bigstring_bytes] instead"] 36 | 37 | val string_bytes : (string, bytes) t 38 | val bytes_bytes : (bytes, bytes) t 39 | val bigstring_bytes : (bigstring, bytes) t 40 | val string_bigstring : (string, bigstring) t 41 | val bytes_bigstring : (bytes, bigstring) t 42 | val bigstring_bigstring : (bigstring, bigstring) t 43 | end 44 | 45 | module%template.portable F (Base : Base) : S with type base = Base.t 46 | end 47 | -------------------------------------------------------------------------------- /core/src/modes.ml: -------------------------------------------------------------------------------- 1 | module Stable = struct 2 | module Global = struct 3 | module V1 = struct 4 | type 'a t = 'a Base.Modes.Global.t = { global : 'a [@globalized] } 5 | [@@unboxed] [@@deriving quickcheck, stable_witness, typerep] 6 | 7 | let%template[@mode m = (global, local)] compare = 8 | (Base.Modes.Global.compare [@mode m]) 9 | ;; 10 | 11 | let t_of_sexp = Base.Modes.Global.t_of_sexp 12 | let sexp_of_t = Base.Modes.Global.sexp_of_t 13 | let map t ~f = Base.Modes.Global.map t ~f 14 | 15 | (* Implement bin-io without adding a UUID. Wrapping with a modality should not 16 | change the bin-shape. *) 17 | include%template 18 | Binable0.Stable.Of_binable1.V1 19 | [@mode local] 20 | [@modality portable] 21 | [@alert "-legacy"] 22 | (struct 23 | type 'a t = 'a [@@deriving bin_io ~localize] 24 | end) 25 | (struct 26 | type 'a t = 'a Base.Modes.Global.t 27 | 28 | let[@mode m = (global, local)] to_binable = Base.Modes.Global.unwrap 29 | let of_binable = Base.Modes.Global.wrap 30 | end) 31 | end 32 | end 33 | end 34 | 35 | open! Base 36 | include Modes 37 | 38 | module Global = struct 39 | include Stable.Global.V1 40 | include Global 41 | end 42 | -------------------------------------------------------------------------------- /core/src/modes.mli: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | module Global : sig 4 | include module type of struct 5 | include Modes.Global 6 | end 7 | 8 | include sig 9 | type 'a t [@@deriving bin_io ~localize, quickcheck, typerep] 10 | end 11 | with type 'a t := 'a t 12 | end 13 | 14 | include module type of struct 15 | include Modes 16 | end [@remove_aliases] 17 | with module Global := Global 18 | 19 | module Stable : sig 20 | module Global : sig 21 | module V1 : sig 22 | type 'a t = 'a Global.t 23 | 24 | include%template 25 | Stable_module_types.With_stable_witness.S1 [@mode local] with type 'a t := 'a t 26 | end 27 | end 28 | end 29 | -------------------------------------------------------------------------------- /core/src/month.mli: -------------------------------------------------------------------------------- 1 | (** Provides a variant type for representing months (e.g., [Jan], [Feb], or [Nov]) and 2 | functions for converting them to other formats (like an int). *) 3 | 4 | include Month_intf.Month (** @inline *) 5 | -------------------------------------------------------------------------------- /core/src/nativeint.ml: -------------------------------------------------------------------------------- 1 | open! Import 2 | 3 | module Binable = struct 4 | type t = nativeint [@@deriving bin_io ~localize] 5 | end 6 | 7 | include Binable 8 | 9 | include%template 10 | Identifiable.Extend [@mode local] [@modality portable] (Base.Nativeint) (Binable) 11 | 12 | include Base.Nativeint 13 | 14 | include%template Comparable.Validate_with_zero [@modality portable] (Base.Nativeint) 15 | 16 | type t = nativeint [@@deriving typerep] 17 | 18 | module Binary = struct 19 | include Binary 20 | 21 | type nonrec t = t [@@deriving typerep, bin_io ~localize] 22 | end 23 | 24 | module Hex = struct 25 | include Hex 26 | 27 | type nonrec t = t [@@deriving typerep, bin_io ~localize] 28 | end 29 | 30 | let quickcheck_generator = Base_quickcheck.Generator.nativeint 31 | let quickcheck_observer = Base_quickcheck.Observer.nativeint 32 | let quickcheck_shrinker = Base_quickcheck.Shrinker.nativeint 33 | let gen_incl = Base_quickcheck.Generator.nativeint_inclusive 34 | let gen_uniform_incl = Base_quickcheck.Generator.nativeint_uniform_inclusive 35 | let gen_log_incl = Base_quickcheck.Generator.nativeint_log_inclusive 36 | let gen_log_uniform_incl = Base_quickcheck.Generator.nativeint_log_uniform_inclusive 37 | -------------------------------------------------------------------------------- /core/src/nativeint.mli: -------------------------------------------------------------------------------- 1 | (** This module extends {{!Base.Nativeint} [Base.Nativeint]}. *) 2 | 3 | (** @inline *) 4 | include module type of struct 5 | include Base.Nativeint 6 | end 7 | 8 | include 9 | Int_intf.Extension with type t := t and type comparator_witness := comparator_witness 10 | 11 | include sig 12 | type t [@@deriving bin_io ~localize] 13 | end 14 | with type t := t 15 | -------------------------------------------------------------------------------- /core/src/never_returns.ml: -------------------------------------------------------------------------------- 1 | open! Import 2 | 3 | type never_returns = Nothing.t [@@deriving sexp_of] 4 | 5 | let%template never_returns : never_returns -> _ = function 6 | | _ -> . 7 | [@@kind k = (value, float64, bits32, bits64, word)] 8 | ;; 9 | -------------------------------------------------------------------------------- /core/src/never_returns.mli: -------------------------------------------------------------------------------- 1 | (** [never_returns] should be used as the return type of functions that don't return and 2 | might block forever, rather than ['a] or [_]. This forces callers of such functions to 3 | have a call to [never_returns] at the call site, which makes it clear to readers 4 | what's going on. We do not intend to use this type for functions such as [failwithf] 5 | that always raise an exception. *) 6 | 7 | open! Import 8 | 9 | type never_returns = Nothing.t [@@deriving sexp_of] 10 | 11 | val%template never_returns : never_returns -> _ 12 | [@@kind k = (value, float64, bits32, bits64, word)] 13 | -------------------------------------------------------------------------------- /core/src/no_polymorphic_compare.ml: -------------------------------------------------------------------------------- 1 | open! Import 2 | 3 | type compare = 4 | [ `no_polymorphic_compare ] 5 | -> [ `no_polymorphic_compare ] 6 | -> [ `no_polymorphic_compare ] 7 | 8 | [%%template 9 | [@@@mode.default m = (local, global)] 10 | 11 | let compare _ _ = `no_polymorphic_compare 12 | let equal _ _ = `no_polymorphic_compare] 13 | 14 | let ( < ) _ _ = `no_polymorphic_compare 15 | let ( <= ) _ _ = `no_polymorphic_compare 16 | let ( > ) _ _ = `no_polymorphic_compare 17 | let ( >= ) _ _ = `no_polymorphic_compare 18 | let ( = ) _ _ = `no_polymorphic_compare 19 | let ( <> ) _ _ = `no_polymorphic_compare 20 | let min _ _ = `no_polymorphic_compare 21 | let max _ _ = `no_polymorphic_compare 22 | -------------------------------------------------------------------------------- /core/src/no_polymorphic_compare.mli: -------------------------------------------------------------------------------- 1 | (** Open this in modules where you don't want to accidentally use polymorphic comparison. 2 | Then, use [Poly.(<)], for example, where needed. *) 3 | 4 | open! Import 5 | 6 | type compare = 7 | [ `no_polymorphic_compare ] 8 | -> [ `no_polymorphic_compare ] 9 | -> [ `no_polymorphic_compare ] 10 | 11 | [%%template: 12 | [@@@mode.default m = (local, global)] 13 | 14 | val compare : compare 15 | val equal : compare] 16 | 17 | val ( < ) : compare 18 | val ( <= ) : compare 19 | val ( > ) : compare 20 | val ( >= ) : compare 21 | val ( = ) : compare 22 | val ( <> ) : compare 23 | val min : compare 24 | val max : compare 25 | -------------------------------------------------------------------------------- /core/src/nothing.ml: -------------------------------------------------------------------------------- 1 | open! Import 2 | 3 | module Stable = struct 4 | module V1 = struct 5 | type t = Base.Nothing.t = | [@@deriving sexp_grammar] 6 | 7 | module Shape = struct 8 | type t [@@deriving bin_shape] 9 | end 10 | 11 | let unreachable_code = Base.Nothing.unreachable_code 12 | let bin_shape_t = Shape.bin_shape_t 13 | let tp_loc = [%here].pos_fname ^ ".Stable.V1.t" 14 | let all = [] 15 | let hash_fold_t _ t = unreachable_code t 16 | let hash = unreachable_code 17 | 18 | [%%template 19 | [@@@mode.default m = (local, global)] 20 | 21 | let compare a _ = unreachable_code a 22 | let equal a _ = unreachable_code a 23 | let bin_size_t = unreachable_code 24 | let bin_write_t _buf ~pos:_ t = unreachable_code t] 25 | 26 | let bin_writer_t = { Bin_prot.Type_class.size = bin_size_t; write = bin_write_t } 27 | 28 | let __bin_read_t__ _buf ~pos_ref _ = 29 | Bin_prot.Common.raise_variant_wrong_type tp_loc !pos_ref 30 | ;; 31 | 32 | let bin_read_t _buf ~pos_ref = 33 | Bin_prot.Common.raise_read_error (Empty_type tp_loc) !pos_ref 34 | ;; 35 | 36 | let bin_reader_t = 37 | { Bin_prot.Type_class.read = bin_read_t; vtag_read = __bin_read_t__ } 38 | ;; 39 | 40 | let bin_t = 41 | { Bin_prot.Type_class.writer = bin_writer_t 42 | ; reader = bin_reader_t 43 | ; shape = bin_shape_t 44 | } 45 | ;; 46 | 47 | let sexp_of_t = unreachable_code 48 | let t_of_sexp sexp = Sexplib.Conv_error.empty_type tp_loc sexp 49 | let stable_witness : t Stable_witness.t = Stable_witness.assert_stable 50 | end 51 | end 52 | 53 | include Stable.V1 54 | include Base.Nothing 55 | 56 | include%template 57 | Identifiable.Extend [@mode local] [@modality portable] (Base.Nothing) (Stable.V1) 58 | -------------------------------------------------------------------------------- /core/src/nothing.mli: -------------------------------------------------------------------------------- 1 | (** This module extends {{!Base.Nothing} [Base.Nothing]}. *) 2 | 3 | open! Import 4 | 5 | (** @inline *) 6 | include module type of struct 7 | include Base.Nothing 8 | end 9 | 10 | (** It may seem weird that this is identifiable, but we're just trying to anticipate all 11 | the contexts in which people may need this. It would be a crying shame if you had some 12 | variant type involving [Nothing.t] that you wished to make identifiable, but were 13 | prevented for lack of [Identifiable.S] here. 14 | 15 | Obviously, [of_string] and [t_of_sexp] will raise an exception. *) 16 | include%template 17 | Identifiable.S 18 | [@mode local] 19 | with type t := t 20 | and type comparator_witness := comparator_witness 21 | 22 | module Stable : sig 23 | module V1 : sig 24 | type nonrec t = t 25 | [@@deriving 26 | bin_io 27 | , compare ~localize 28 | , enumerate 29 | , equal ~localize 30 | , hash 31 | , sexp 32 | , stable_witness 33 | , sexp_grammar] 34 | end 35 | end 36 | -------------------------------------------------------------------------------- /core/src/ofday_float.mli: -------------------------------------------------------------------------------- 1 | open! Import 2 | include Ofday_intf.S with type underlying = float and module Span := Span_float 3 | 4 | module Stable : sig 5 | module V1 : sig 6 | type nonrec t = t 7 | [@@deriving 8 | bin_io ~localize 9 | , compare ~localize 10 | , equal ~localize 11 | , globalize 12 | , hash 13 | , sexp 14 | , sexp_grammar 15 | , stable_witness 16 | , diff] 17 | end 18 | end 19 | -------------------------------------------------------------------------------- /core/src/ofday_ns.mli: -------------------------------------------------------------------------------- 1 | open! Import 2 | include Time_ns_intf.Ofday with module Span := Span_ns 3 | 4 | module Stable : sig 5 | module V1 : sig 6 | type nonrec t = t 7 | [@@deriving 8 | bin_io ~localize 9 | , compare ~localize 10 | , equal ~localize 11 | , globalize 12 | , hash 13 | , sexp_grammar 14 | , typerep] 15 | 16 | include%template 17 | Stable_int63able.With_stable_witness.S 18 | [@mode local] 19 | with type t := t 20 | and type comparator_witness = comparator_witness 21 | 22 | include Diffable.S_atomic with type t := t 23 | end 24 | 25 | module Option : sig end [@@deprecated "[since 2021-02] Use [Time_ns_unix.Stable]"] 26 | module Zoned : sig end [@@deprecated "[since 2021-02] Use [Time_ns_unix.Stable]"] 27 | end 28 | -------------------------------------------------------------------------------- /core/src/only_in_test.ml: -------------------------------------------------------------------------------- 1 | open! Import 2 | include Lazy 3 | 4 | let of_thunk = from_fun 5 | -------------------------------------------------------------------------------- /core/src/only_in_test.mli: -------------------------------------------------------------------------------- 1 | (** This module can be used to safely expose functions and values in signatures that 2 | should only be used in unit tests. 3 | 4 | Under the hood, ['a t = 'a Lazy.t] and the only thing that ever forces them is the 5 | [force] function below which should only be called in unit tests. 6 | 7 | For example, suppose in some module, [type t] is actually an [int]. You want to keep 8 | the type definition opaque, but use the underlying representation in unit tests. You 9 | could write in the ml: 10 | 11 | {[ 12 | let test_to_int t = Only_in_test.return t 13 | let test_of_int n = Only_in_test.return n 14 | ]} 15 | 16 | You would then expose in the mli: 17 | 18 | {[ 19 | type t 20 | 21 | val test_to_int : t -> int Only_in_test.t 22 | val test_of_int : int -> t Only_in_test.t 23 | ]} 24 | 25 | Finally, if you have specific values that you might want to use in unit tests, but 26 | that have top-level side-effects or take too long to compute, you can delay the 27 | side-effects or computation until the unit tests are run by writing, e.g.: 28 | 29 | [let (test_special_value : t Only_in_test.t) = Only_in_test.of_thunk (fun () -> factorial 100)] 30 | 31 | instead of 32 | 33 | [let (test_special_value : t Only_in_test.t) = Only_in_test.return (factorial 100)] *) 34 | 35 | open! Import 36 | 37 | type +'a t 38 | 39 | include Monad.S with type 'a t := 'a t 40 | 41 | val of_thunk : (unit -> 'a) -> 'a t 42 | val force : 'a t -> 'a 43 | -------------------------------------------------------------------------------- /core/src/option.mli: -------------------------------------------------------------------------------- 1 | (** This module extends {{!Base.Option} [Base.Option]} with bin_io, quickcheck, and 2 | support for ppx_optional. *) 3 | 4 | type 'a t = 'a Base.Option.t [@@deriving bin_io ~localize, typerep] 5 | 6 | type%template 'a t = ('a Base.Option.t[@kind k]) 7 | [@@deriving bin_io ~localize] [@@kind k = (float64, bits32, bits64, word)] 8 | 9 | (** @inline *) 10 | include module type of struct 11 | include Base.Option 12 | end 13 | with type 'a t := 'a option 14 | with type 'a t__float64 := 'a t__float64 15 | with type 'a t__bits32 := 'a t__bits32 16 | with type 'a t__bits64 := 'a t__bits64 17 | with type 'a t__word := 'a t__word 18 | 19 | include Comparator.Derived with type 'a t := 'a t 20 | 21 | include%template Quickcheckable.S1 [@mode portable] with type 'a t := 'a t 22 | 23 | val validate : none:unit Validate.check -> some:'a Validate.check -> 'a t Validate.check 24 | 25 | module Stable : sig 26 | module V1 : sig 27 | type nonrec 'a t = 'a t 28 | [@@deriving 29 | bin_io ~localize 30 | , compare ~localize 31 | , equal ~localize 32 | , hash 33 | , sexp 34 | , sexp_grammar 35 | , stable_witness] 36 | end 37 | end 38 | 39 | (** You might think that it's pointless to have [Optional_syntax] on options because OCaml 40 | already has nice syntax for matching on options. The reason to have this here is that 41 | you might have, for example, a tuple of an option and some other type that supports 42 | [Optional_syntax]. Since [Optional_syntax] can only be opted into at the granularity 43 | of the whole match expression, we need this [Optional_syntax] support for options in 44 | order to use it for the other half of the tuple. *) 45 | module%template Optional_syntax : 46 | Optional_syntax.S1 [@mode local] with type 'a t := 'a t and type 'a value := 'a 47 | -------------------------------------------------------------------------------- /core/src/option_array.ml: -------------------------------------------------------------------------------- 1 | open! Import 2 | open! Base_quickcheck.Export 3 | include Base.Option_array 4 | 5 | module Array_of_options = struct 6 | type 'a t = 'a option array [@@deriving sexp, bin_io, quickcheck ~portable] 7 | end 8 | 9 | include%template 10 | Binable.Of_binable1_without_uuid [@modality portable] [@alert "-legacy"] 11 | (Array_of_options) 12 | (struct 13 | type nonrec 'a t = 'a t 14 | 15 | let to_binable = to_array 16 | let of_binable = of_array 17 | end) 18 | 19 | include%template 20 | Quickcheckable.Of_quickcheckable1 [@modality portable] 21 | (Array_of_options) 22 | (struct 23 | type nonrec 'a t = 'a t 24 | 25 | let to_quickcheckable = to_array 26 | let of_quickcheckable = of_array 27 | end) 28 | -------------------------------------------------------------------------------- /core/src/option_array.mli: -------------------------------------------------------------------------------- 1 | (** This module extends {{!Base.Option_array} [Base.Option_array]} with bin_io. *) 2 | 3 | open! Import 4 | 5 | type 'a t = 'a Base.Option_array.t [@@deriving bin_io, quickcheck, sexp, sexp_grammar] 6 | 7 | include module type of struct 8 | include Base.Option_array 9 | end 10 | with type 'a t := 'a t 11 | -------------------------------------------------------------------------------- /core/src/optional_syntax.ml: -------------------------------------------------------------------------------- 1 | open! Import 2 | 3 | include Optional_syntax_intf (** @inline *) 4 | -------------------------------------------------------------------------------- /core/src/optional_syntax.mli: -------------------------------------------------------------------------------- 1 | (** Interfaces for use with the [match%optional] syntax, provided by [ppx_optional]. *) 2 | 3 | include Optional_syntax_intf.Optional_syntax (** @inline *) 4 | -------------------------------------------------------------------------------- /core/src/or_error.ml: -------------------------------------------------------------------------------- 1 | open! Import 2 | include Base.Or_error 3 | 4 | type%template 'a t = (('a, Error.t) Result.t[@kind k]) 5 | [@@deriving bin_io] [@@kind k = (float64, bits32, bits64, word)] 6 | 7 | type 'a t = ('a, Error.t) Result.t 8 | [@@deriving bin_io, diff ~extra_derive:[ sexp ], quickcheck] 9 | 10 | module Expect_test_config = struct 11 | module IO = Base.Or_error 12 | 13 | let run f = ok_exn (f ()) 14 | let sanitize s = s 15 | let upon_unreleasable_issue = Expect_test_config.upon_unreleasable_issue 16 | end 17 | 18 | module Expect_test_config_with_unit_expect = Expect_test_config 19 | 20 | module Stable = struct 21 | module V1 = struct 22 | type 'a t = ('a, Error.Stable.V1.t) Result.Stable.V1.t 23 | [@@deriving bin_io ~localize, compare ~localize, sexp, stable_witness] 24 | 25 | let map x ~f = Result.Stable.V1.map x ~f1:f ~f2:Fn.id 26 | end 27 | 28 | module V2 = struct 29 | type 'a t = ('a, Error.Stable.V2.t) Result.Stable.V1.t 30 | [@@deriving 31 | bin_io ~localize 32 | , compare ~localize 33 | , equal ~localize 34 | , sexp 35 | , sexp_grammar 36 | , stable_witness 37 | , diff] 38 | 39 | let map x ~f = Result.Stable.V1.map x ~f1:f ~f2:Fn.id 40 | end 41 | end 42 | -------------------------------------------------------------------------------- /core/src/or_error.mli: -------------------------------------------------------------------------------- 1 | (** This module extends {{!Base.Or_error} [Base.Or_error]} with bin_io, diff, and 2 | quickcheck. *) 3 | 4 | open! Import 5 | 6 | type%template 'a t = ('a Base.Or_error.t[@kind k]) 7 | [@@deriving bin_io] [@@kind k = (float64, bits32, bits64, word)] 8 | 9 | type 'a t = ('a, Error.t) Result.t 10 | [@@deriving bin_io, diff ~extra_derive:[ sexp ], quickcheck] 11 | 12 | (** @inline *) 13 | include module type of struct 14 | include Base.Or_error 15 | end 16 | with type 'a t := 'a t 17 | with type 'a t__float64 := 'a t__float64 18 | with type 'a t__bits32 := 'a t__bits32 19 | with type 'a t__bits64 := 'a t__bits64 20 | with type 'a t__word := 'a t__word 21 | 22 | module Expect_test_config : Expect_test_config_types.S with type 'a IO.t = 'a t 23 | 24 | module Expect_test_config_with_unit_expect = Expect_test_config 25 | [@@deprecated "[since 2022-05] Use [Expect_test_config] instead, it is equivalent."] 26 | 27 | module Stable : sig 28 | (** [Or_error.t] is wire compatible with [V2.t], but not [V1.t], like [Info.Stable] and 29 | [Error.Stable]. *) 30 | module%template V1 : 31 | Stable_module_types.With_stable_witness.S1 [@mode local] with type 'a t = 'a t 32 | 33 | module V2 : sig 34 | type nonrec 'a t = 'a t 35 | [@@deriving equal ~localize, sexp_grammar, diff ~extra_derive:[ sexp; bin_io ]] 36 | 37 | include%template 38 | Stable_module_types.With_stable_witness.S1 [@mode local] with type 'a t := 'a t 39 | end 40 | end 41 | -------------------------------------------------------------------------------- /core/src/ordered_collection_common.ml: -------------------------------------------------------------------------------- 1 | include Base.Ordered_collection_common 2 | 3 | let normalize ~length_fun t i = if i < 0 then i + length_fun t else i 4 | 5 | let slice ~length_fun ~sub_fun t start stop = 6 | let stop = if stop = 0 then length_fun t else stop in 7 | let pos = normalize ~length_fun t start in 8 | let len = normalize ~length_fun t stop - pos in 9 | sub_fun t ~pos ~len 10 | ;; 11 | -------------------------------------------------------------------------------- /core/src/ordered_collection_common.mli: -------------------------------------------------------------------------------- 1 | (** This module extends {{!Base.Ordered_collection_common} 2 | [Base.Ordered_collection_common]}. *) 3 | 4 | include module type of struct 5 | include Base.Ordered_collection_common 6 | end 7 | 8 | val normalize : length_fun:('a -> int) -> 'a -> int -> int 9 | 10 | val slice 11 | : length_fun:('a -> int) 12 | -> sub_fun:('a -> pos:int -> len:int -> 'a) 13 | -> 'a 14 | -> int 15 | -> int 16 | -> 'a 17 | -------------------------------------------------------------------------------- /core/src/ordering.ml: -------------------------------------------------------------------------------- 1 | open! Import 2 | 3 | type t = Base.Ordering.t = 4 | | Less 5 | | Equal 6 | | Greater 7 | [@@deriving bin_io, compare ~localize, hash, sexp, sexp_grammar] 8 | 9 | module type Base_mask = module type of Base.Ordering with type t := t 10 | 11 | include (Base.Ordering : Base_mask) 12 | -------------------------------------------------------------------------------- /core/src/ordering.mli: -------------------------------------------------------------------------------- 1 | (** Extends {{!Base.Ordering} [Base.Ordering]}, intended to make code that matches on the 2 | result of a comparison more concise and easier to read. *) 3 | 4 | open! Import 5 | 6 | type t = Base.Ordering.t = 7 | | Less 8 | | Equal 9 | | Greater 10 | [@@deriving bin_io, compare ~localize, hash, sexp, sexp_grammar] 11 | 12 | include module type of Base.Ordering with type t := t (** @inline *) 13 | -------------------------------------------------------------------------------- /core/src/pid.mli: -------------------------------------------------------------------------------- 1 | (** Process ID. *) 2 | 3 | open! Import 4 | 5 | type t [@@deriving bin_io, hash, sexp, sexp_grammar, quickcheck] [@@immediate] 6 | 7 | include%template Identifiable.S [@mode local] with type t := t 8 | 9 | val of_int : int -> t 10 | val to_int : t -> int 11 | 12 | (** The pid of the "init" process, which is [1] by convention. *) 13 | val init : t 14 | 15 | module Stable : sig 16 | module V1 : sig 17 | type nonrec t = t [@@deriving equal ~localize] 18 | 19 | include%template 20 | Stable_comparable.With_stable_witness.V1 21 | [@mode local] 22 | with type t := t 23 | and type comparator_witness = comparator_witness 24 | end 25 | end 26 | -------------------------------------------------------------------------------- /core/src/portable_lazy.mli: -------------------------------------------------------------------------------- 1 | open! Import 2 | 3 | (** @inline *) 4 | include module type of struct 5 | include Base.Portable_lazy 6 | end 7 | 8 | [%%rederive: type nonrec 'a t = 'a t [@@deriving bin_io, quickcheck]] 9 | 10 | module Stable : sig 11 | module V1 : sig 12 | type nonrec 'a t = 'a t [@@deriving sexp_grammar] 13 | 14 | [%%rederive: 15 | type nonrec 'a t = 'a t 16 | [@@deriving compare ~localize, equal ~localize, hash, sexp_of]] 17 | 18 | [%%rederive: type nonrec 'a t = 'a t [@@deriving of_sexp]] 19 | [%%rederive: type nonrec 'a t = 'a t [@@deriving bin_io]] 20 | end 21 | end 22 | -------------------------------------------------------------------------------- /core/src/printexc.ml: -------------------------------------------------------------------------------- 1 | open! Import 2 | 3 | let to_string _ = `Deprecated_use_Exn_to_string_instead 4 | let print _ = `Deprecated_use_Exn_to_string_instead 5 | let catch _ _ = `Deprecated_use_Exn_handle_uncaught_instead 6 | let print_backtrace = Stdlib.Printexc.print_backtrace 7 | let get_backtrace = Stdlib.Printexc.get_backtrace 8 | let record_backtrace = Stdlib.Printexc.record_backtrace 9 | let backtrace_status = Stdlib.Printexc.backtrace_status 10 | -------------------------------------------------------------------------------- /core/src/printexc.mli: -------------------------------------------------------------------------------- 1 | (** This module is here to ensure that we don't use the functions in [Caml.Printexc] 2 | inadvertently. *) 3 | 4 | open! Import 5 | 6 | val to_string : exn -> [ `Deprecated_use_Exn_to_string_instead ] 7 | val print : exn -> [ `Deprecated_use_Exn_to_string_instead ] 8 | val catch : ('a -> _) -> 'a -> [ `Deprecated_use_Exn_handle_uncaught_instead ] 9 | val print_backtrace : out_channel -> unit 10 | val get_backtrace : unit -> string 11 | val record_backtrace : bool -> unit 12 | val backtrace_status : unit -> bool 13 | -------------------------------------------------------------------------------- /core/src/printf.ml: -------------------------------------------------------------------------------- 1 | (** This module extends {{!Base.Printf} [Base.Printf]}. *) 2 | 3 | open! Import 4 | 5 | include Base.Printf (** @open *) 6 | 7 | let eprintf = Stdio.Out_channel.eprintf 8 | let fprintf = Stdio.Out_channel.fprintf 9 | let kfprintf = Stdio.Out_channel.kfprintf 10 | let printf = Stdio.Out_channel.printf 11 | 12 | (** print to stderr; exit 1 *) 13 | let exitf fmt = 14 | ksprintf 15 | (fun s () -> 16 | eprintf "%s\n%!" s; 17 | exit 1) 18 | fmt 19 | ;; 20 | 21 | type printf = { printf : 'a. ('a, Buffer.t, unit) format -> 'a } 22 | 23 | let collect_to_string f = 24 | let buf = Buffer.create 64 in 25 | let done_ = ref false in 26 | let printf fmt = 27 | kbprintf 28 | (fun buf -> 29 | if !done_ 30 | then ( 31 | Buffer.reset buf; 32 | raise_s [%message "[printf] used after [collect_to_string] returned"])) 33 | buf 34 | fmt 35 | in 36 | f { printf }; 37 | done_ := true; 38 | let output = Buffer.contents buf in 39 | Buffer.reset buf; 40 | output 41 | ;; 42 | -------------------------------------------------------------------------------- /core/src/printf.mli: -------------------------------------------------------------------------------- 1 | open! Import 2 | 3 | (** @inline *) 4 | include module type of struct 5 | include Base.Printf 6 | end 7 | 8 | val eprintf : ('a, out_channel, unit) format -> 'a 9 | val fprintf : out_channel -> ('a, out_channel, unit) format -> 'a 10 | 11 | val kfprintf 12 | : (out_channel -> 'a) 13 | -> out_channel 14 | -> ('b, out_channel, unit, 'a) format4 15 | -> 'b 16 | 17 | val printf : ('a, out_channel, unit) format -> 'a 18 | 19 | (** print to stderr; exit 1 *) 20 | val exitf : ('a, unit, string, unit -> _) format4 -> 'a 21 | 22 | type printf = { printf : 'a. ('a, Buffer.t, unit) format -> 'a } 23 | 24 | (** [collect_to_string (fun { printf } -> ...)] lets you easily convert code that was 25 | printing to stdout into code that produces a string. 26 | 27 | For example, this original code... 28 | {[ 29 | printf "hello "; 30 | (* long computation *) 31 | printf "%s%c" "world" '!' 32 | ]} 33 | 34 | ... can be wrapped like so. 35 | {[ 36 | Printf.collect_to_string (fun { printf } -> 37 | printf "hello "; 38 | (* long computation *) 39 | printf "%s%c" "world" '!') 40 | ]} 41 | 42 | The above is easier than manually editing many lines of the original: 43 | {[ 44 | let hello = sprintf "hello " in 45 | (* long computation *) 46 | let world = sprintf "%s%c" "world" '!' in 47 | hello ^ world 48 | ]} *) 49 | val collect_to_string : (printf -> unit) -> string 50 | -------------------------------------------------------------------------------- /core/src/queue.mli: -------------------------------------------------------------------------------- 1 | (** This module extends {{!Base.Queue} [Base.Queue]} with bin_io. *) 2 | 3 | open! Import 4 | 5 | type 'a t = 'a Base.Queue.t [@@deriving sexp_of, bin_io, quickcheck] 6 | 7 | (** {2 The interface from Base} *) 8 | 9 | include module type of Base.Queue with type 'a t := 'a t (** @inline *) 10 | 11 | (** {2 Extensions} *) 12 | 13 | include Binary_searchable.S1 with type 'a t := 'a t 14 | 15 | module Stable : sig 16 | module V1 : sig 17 | type nonrec 'a t = 'a t [@@deriving equal ~localize] 18 | 19 | include Stable_module_types.With_stable_witness.S1 with type 'a t := 'a t 20 | end 21 | end 22 | -------------------------------------------------------------------------------- /core/src/quickcheck.mli: -------------------------------------------------------------------------------- 1 | include Quickcheck_intf.Quickcheck (** @inline *) 2 | -------------------------------------------------------------------------------- /core/src/quickcheckable.mli: -------------------------------------------------------------------------------- 1 | include Quickcheckable_intf.Quickcheckable (** @inline *) 2 | -------------------------------------------------------------------------------- /core/src/ref.ml: -------------------------------------------------------------------------------- 1 | open! Import 2 | open Base_quickcheck.Export 3 | 4 | module T = struct 5 | include Base.Ref 6 | 7 | include ( 8 | struct 9 | type 'a t = 'a ref [@@deriving bin_io ~localize, quickcheck, typerep] 10 | end : 11 | sig 12 | type 'a t = 'a ref [@@deriving bin_io ~localize, quickcheck, typerep] 13 | end 14 | with type 'a t := 'a t) 15 | end 16 | 17 | include T 18 | 19 | module Permissioned = struct 20 | include T 21 | 22 | type ('a, -'perms) t = 'a T.t [@@deriving bin_io ~localize, sexp, sexp_grammar] 23 | 24 | let read_only = Fn.id 25 | let of_ref = Fn.id 26 | let to_ref = Fn.id 27 | let set = ( := ) 28 | let get = ( ! ) 29 | end 30 | -------------------------------------------------------------------------------- /core/src/ref.mli: -------------------------------------------------------------------------------- 1 | (** This module extends {{!Base.Ref} [Base.Ref]}. *) 2 | 3 | open! Import 4 | open Perms.Export 5 | 6 | type 'a t = 'a Base.Ref.t = { mutable contents : 'a } 7 | [@@deriving bin_io ~localize, quickcheck, typerep] 8 | 9 | (** @inline *) 10 | include module type of struct 11 | include Base.Ref 12 | end 13 | with type 'a t := 'a t 14 | 15 | module Permissioned : sig 16 | type (!'a, -'perms) t [@@deriving sexp, sexp_grammar, bin_io ~localize] 17 | 18 | val create : 'a -> ('a, [< _ perms ]) t 19 | val read_only : ('a, [> read ]) t -> ('a, read) t 20 | 21 | (** [get] and [(!)] are two names for the same function. *) 22 | val ( ! ) : ('a, [> read ]) t -> 'a 23 | 24 | val get : ('a, [> read ]) t -> 'a 25 | 26 | (** [set] and [(:=)] are two names for the same function. *) 27 | val set : ('a, [> write ]) t -> 'a -> unit 28 | 29 | val ( := ) : ('a, [> write ]) t -> 'a -> unit 30 | val of_ref : 'a ref -> ('a, [< read_write ]) t 31 | val to_ref : ('a, [> read_write ]) t -> 'a ref 32 | val swap : ('a, [> read_write ]) t -> ('a, [> read_write ]) t -> unit 33 | val replace : ('a, [> read_write ]) t -> ('a -> 'a) -> unit 34 | val set_temporarily : ('a, [> read_write ]) t -> 'a -> f:(unit -> 'b) -> 'b 35 | end 36 | -------------------------------------------------------------------------------- /core/src/result.ml: -------------------------------------------------------------------------------- 1 | open! Import 2 | module Result = Base.Result 3 | 4 | module Stable = struct 5 | module V1 = struct 6 | type ('a, 'b) t = ('a, 'b) Result.t = 7 | | Ok of 'a 8 | | Error of 'b 9 | [@@deriving 10 | bin_io ~localize 11 | , compare ~localize 12 | , diff 13 | , equal ~localize 14 | , globalize 15 | , hash 16 | , sexp ~localize 17 | , sexp_grammar 18 | , stable_witness 19 | , typerep] 20 | 21 | let map x ~f1 ~f2 = 22 | match x with 23 | | Error err -> Error (f2 err) 24 | | Ok x -> Ok (f1 x) 25 | ;; 26 | end 27 | 28 | module V1_stable_unit_test = struct 29 | type t = (string, int) V1.t 30 | [@@deriving bin_io, compare ~localize, equal ~localize, hash, sexp] 31 | 32 | let tests = 33 | [ V1.Ok "foo", "(Ok foo)", "\000\003foo"; V1.Error 7, "(Error 7)", "\001\007" ] 34 | ;; 35 | end 36 | end 37 | 38 | include Stable.V1 39 | include Result 40 | 41 | type%template ('a, 'b) t = (('a, 'b) Result.t[@kind k]) = 42 | | Ok of 'a 43 | | Error of 'b 44 | [@@deriving bin_io ~localize] [@@kind k = (float64, bits32, bits64, word)] 45 | 46 | let quickcheck_generator = Base_quickcheck.Generator.result 47 | let quickcheck_observer = Base_quickcheck.Observer.result 48 | let quickcheck_shrinker = Base_quickcheck.Shrinker.result 49 | -------------------------------------------------------------------------------- /core/src/result.mli: -------------------------------------------------------------------------------- 1 | (** This module extends {{!Base.Result} [Base.Result]}. *) 2 | 3 | open! Import 4 | 5 | type%template ('a, 'b) t = (('a, 'b) Base.Result.t[@kind k]) = 6 | | Ok of 'a 7 | | Error of 'b 8 | [@@deriving bin_io ~localize] [@@kind k = (float64, bits32, bits64, word)] 9 | 10 | type ('a, 'b) t = ('a, 'b) Base.Result.t = 11 | | Ok of 'a 12 | | Error of 'b 13 | [@@deriving bin_io ~localize, diff ~extra_derive:[ sexp ], quickcheck, typerep] 14 | 15 | include 16 | module type of Base.Result 17 | with type ('a, 'b) t := ('a, 'b) t 18 | with type ('a, 'b) t__float64 := ('a, 'b) t__float64 19 | with type ('a, 'b) t__bits32 := ('a, 'b) t__bits32 20 | with type ('a, 'b) t__bits64 := ('a, 'b) t__bits64 21 | with type ('a, 'b) t__word := ('a, 'b) t__word 22 | (** @inline *) 23 | 24 | module Stable : sig 25 | module V1 : sig 26 | type nonrec ('ok, 'err) t = ('ok, 'err) t = 27 | | Ok of 'ok 28 | | Error of 'err 29 | [@@deriving bin_io ~localize, equal ~localize, globalize, sexp_grammar] 30 | 31 | include%template 32 | Stable_module_types.With_stable_witness.S2 33 | [@mode local] 34 | with type ('ok, 'err) t := ('ok, 'err) t 35 | 36 | include 37 | Diffable.S2 38 | with type ('ok, 'err) t := ('ok, 'err) t 39 | and type ('ok, 'err, 'ok_diff, 'err_diff) Diff.t = 40 | ('ok, 'err, 'ok_diff, 'err_diff) Diff.t 41 | end 42 | 43 | (** We export the unit test arg rather than instantiate the functor inside result.ml in 44 | order to avoid circular dependencies. The functor is instantiated in stable.ml. *) 45 | module V1_stable_unit_test : Stable_unit_test_intf.Arg 46 | end 47 | -------------------------------------------------------------------------------- /core/src/robustly_comparable.ml: -------------------------------------------------------------------------------- 1 | (** This interface compares float-like objects with a small tolerance. 2 | 3 | For example [=.] returns true if the floats are almost but not quite equal, and [>.] 4 | returns false if the floats are almost equal. The tolerance is intended to be about 5 | right for human-entered values like prices and seconds. *) 6 | 7 | module type S = sig 8 | type t 9 | 10 | val ( >=. ) : t -> t -> bool 11 | val ( <=. ) : t -> t -> bool 12 | val ( =. ) : t -> t -> bool 13 | val ( >. ) : t -> t -> bool 14 | val ( <. ) : t -> t -> bool 15 | val ( <>. ) : t -> t -> bool 16 | val robustly_compare : t -> t -> int 17 | end 18 | -------------------------------------------------------------------------------- /core/src/sexpable.mli: -------------------------------------------------------------------------------- 1 | (** This module extends {!Base.Sexpable}. *) 2 | 3 | open! Import 4 | 5 | (** @inline *) 6 | include module type of struct 7 | include Base.Sexpable 8 | end 9 | 10 | module%template.portable To_stringable (M : S) : Stringable.S with type t := M.t 11 | 12 | (** The following functors preserve stability: if applied to stable types with stable 13 | (de)serializations, they will produce stable types with stable (de)serializations. 14 | 15 | Note: In all cases, stability of the input (and therefore the output) depends on the 16 | semantics of all conversion functions (e.g. to_string, to_sexpable) not changing in 17 | the future. *) 18 | module%template Stable : sig 19 | module Of_sexpable : sig 20 | module%template [@modality p = (portable, nonportable)] V1 : 21 | module type of Of_sexpable [@modality p] 22 | end 23 | 24 | module Of_sexpable1 : sig 25 | module%template [@modality p = (portable, nonportable)] V1 : 26 | module type of Of_sexpable1 [@modality p] 27 | end 28 | 29 | module Of_sexpable2 : sig 30 | module%template [@modality p = (portable, nonportable)] V1 : 31 | module type of Of_sexpable2 [@modality p] 32 | end 33 | 34 | module Of_sexpable3 : sig 35 | module%template [@modality p = (portable, nonportable)] V1 : 36 | module type of Of_sexpable3 [@modality p] 37 | end 38 | 39 | module Of_stringable : sig 40 | module%template [@modality p = (portable, nonportable)] V1 : 41 | module type of Of_stringable [@modality p] 42 | end 43 | 44 | module To_stringable : sig 45 | module%template [@modality p = (portable, nonportable)] V1 : 46 | module type of To_stringable [@modality p] 47 | end 48 | end 49 | -------------------------------------------------------------------------------- /core/src/sign.ml: -------------------------------------------------------------------------------- 1 | open! Import 2 | module Sign = Base.Sign 3 | 4 | module Stable = struct 5 | module V1 = struct 6 | type t = Sign.t = 7 | | Neg 8 | | Zero 9 | | Pos 10 | [@@deriving 11 | sexp, sexp_grammar, bin_io ~localize, compare ~localize, hash, typerep, enumerate] 12 | end 13 | end 14 | 15 | include Stable.V1 16 | include Sign 17 | 18 | include%template Identifiable.Extend [@mode local] [@modality portable] (Sign) (Stable.V1) 19 | -------------------------------------------------------------------------------- /core/src/sign.mli: -------------------------------------------------------------------------------- 1 | (** This module extends {{!Base.Sign} [Base.Sign]} with bin_io. *) 2 | 3 | open! Import 4 | 5 | type t = Base.Sign.t = 6 | | Neg 7 | | Zero 8 | | Pos 9 | [@@deriving typerep] 10 | 11 | include module type of Base.Sign with type t := t (** @inline *) 12 | 13 | (** This provides [to_string]/[of_string], sexp/bin_io conversion, Map, Hashtbl, etc. *) 14 | include%template 15 | Identifiable.S 16 | [@mode local] 17 | with type t := t 18 | and type comparator_witness := comparator_witness 19 | 20 | module Stable : sig 21 | module V1 : sig 22 | type nonrec t = t = 23 | | Neg 24 | | Zero 25 | | Pos 26 | [@@deriving bin_io, compare ~localize, hash, sexp, sexp_grammar] 27 | end 28 | end 29 | -------------------------------------------------------------------------------- /core/src/sign_or_nan.ml: -------------------------------------------------------------------------------- 1 | open! Import 2 | module Sign_or_nan = Base.Sign_or_nan 3 | 4 | module Stable = struct 5 | module V1 = struct 6 | type t = Sign_or_nan.t = 7 | | Neg 8 | | Zero 9 | | Pos 10 | | Nan 11 | [@@deriving 12 | sexp, sexp_grammar, bin_io ~localize, compare ~localize, hash, typerep, enumerate] 13 | end 14 | end 15 | 16 | include Stable.V1 17 | include Sign_or_nan 18 | 19 | include%template 20 | Identifiable.Extend [@mode local] [@modality portable] (Sign_or_nan) (Stable.V1) 21 | -------------------------------------------------------------------------------- /core/src/sign_or_nan.mli: -------------------------------------------------------------------------------- 1 | (** This module extends {{!Base.Sign_or_nan} [Base.Sign_or_nan]} with bin_io. *) 2 | 3 | open! Import 4 | 5 | type t = Base.Sign_or_nan.t = 6 | | Neg 7 | | Zero 8 | | Pos 9 | | Nan 10 | [@@deriving typerep] 11 | 12 | include module type of Base.Sign_or_nan with type t := t (** @inline *) 13 | 14 | (** This provides [to_string]/[of_string], sexp/bin_io conversion, Map, Hashtbl, etc. *) 15 | include%template 16 | Identifiable.S 17 | [@mode local] 18 | with type t := t 19 | and type comparator_witness := comparator_witness 20 | 21 | module Stable : sig 22 | module V1 : sig 23 | type nonrec t = t = 24 | | Neg 25 | | Zero 26 | | Pos 27 | | Nan 28 | [@@deriving bin_io, compare ~localize, hash, sexp, sexp_grammar] 29 | end 30 | end 31 | -------------------------------------------------------------------------------- /core/src/source_code_position.ml: -------------------------------------------------------------------------------- 1 | open! Import 2 | 3 | module T = struct 4 | include Base.Source_code_position 5 | include Source_code_position0 6 | 7 | include%template 8 | Comparable.Extend [@mode local] [@modality portable] 9 | (Base.Source_code_position) 10 | (Source_code_position0) 11 | 12 | include%template Hashable.Make [@modality portable] (Source_code_position0) 13 | end 14 | 15 | include T 16 | 17 | module With_hiding = struct 18 | include T 19 | 20 | let to_string t = 21 | if am_running_test then String.concat [ t.pos_fname; ":LINE:COL" ] else to_string t 22 | ;; 23 | 24 | let sexp_of_t t = Sexp.Atom (to_string t) 25 | end 26 | -------------------------------------------------------------------------------- /core/src/source_code_position.mli: -------------------------------------------------------------------------------- 1 | (** This module extends {{!Base.Source_code_position} [Base.Source_code_position]}. *) 2 | 3 | module type S := sig 4 | (** @inline *) 5 | include module type of struct 6 | include Base.Source_code_position 7 | end 8 | 9 | type t = Base.Source_code_position.t = 10 | { pos_fname : string 11 | ; pos_lnum : int 12 | ; pos_bol : int 13 | ; pos_cnum : int 14 | } 15 | [@@deriving fields ~getters, globalize] 16 | 17 | include%template 18 | Comparable.S 19 | [@mode local] 20 | with type t := t 21 | and type comparator_witness := comparator_witness 22 | 23 | include Hashable.S with type t := t 24 | 25 | module Stable : sig 26 | module V1 : sig 27 | type nonrec t = t [@@deriving equal ~localize] 28 | 29 | include%template 30 | Stable_module_types.With_stable_witness.S0 [@mode local] with type t := t 31 | end 32 | end 33 | end 34 | 35 | include S (** @inline *) 36 | 37 | (** [With_hiding] differs in that [to_string] and [sexp_of_t], in test, show [LINE] and 38 | [COL] rather than the actual line and column. Eliding the numbers makes tests that 39 | includes source-code positions more robust because output doesn't change unless 40 | filenames change. [Source_code_position_with_hiding] makes this behavior automatic, 41 | which is easier than manually hiding via other mechanisms, e.g. using 42 | [Expect_test_helpers] with [~hide_positions:true]. 43 | 44 | Idiomatic usage is: 45 | 46 | {[ 47 | module Source_code_position = Source_code_position.With_hiding 48 | ]} *) 49 | module With_hiding : S 50 | -------------------------------------------------------------------------------- /core/src/source_code_position0.ml: -------------------------------------------------------------------------------- 1 | open! Import 2 | 3 | module Stable = struct 4 | module V1 = struct 5 | include Base.Source_code_position 6 | 7 | type t = Base.Source_code_position.t = 8 | { pos_fname : string 9 | ; pos_lnum : int 10 | ; pos_bol : int 11 | ; pos_cnum : int 12 | } 13 | [@@deriving 14 | bin_io ~localize 15 | , compare ~localize 16 | , equal ~localize 17 | , fields ~getters 18 | , globalize 19 | , hash 20 | , sexp 21 | , sexp_grammar 22 | , stable_witness] 23 | end 24 | end 25 | 26 | include Stable.V1 27 | 28 | let to_string = Base.Source_code_position.to_string 29 | let sexp_of_t = Base.Source_code_position.sexp_of_t 30 | -------------------------------------------------------------------------------- /core/src/source_code_position0.mli: -------------------------------------------------------------------------------- 1 | open! Import 2 | 3 | include module type of struct 4 | include Base.Source_code_position 5 | end 6 | 7 | type t = Base.Source_code_position.t = 8 | { pos_fname : string 9 | ; pos_lnum : int 10 | ; pos_bol : int 11 | ; pos_cnum : int 12 | } 13 | [@@deriving 14 | bin_io ~localize 15 | , compare ~localize 16 | , fields ~getters 17 | , globalize 18 | , hash 19 | , sexp 20 | , sexp_grammar] 21 | 22 | module Stable : sig 23 | module V1 : sig 24 | type nonrec t = t 25 | [@@deriving 26 | bin_io ~localize 27 | , compare ~localize 28 | , equal ~localize 29 | , hash 30 | , sexp 31 | , sexp_grammar 32 | , stable_witness] 33 | 34 | include Comparator.Stable.V1.S with type t := t 35 | end 36 | end 37 | -------------------------------------------------------------------------------- /core/src/span_helpers.ml: -------------------------------------------------------------------------------- 1 | open! Import 2 | open Std_internal 3 | 4 | let randomize span random_state ~percent ~scale = 5 | let mult = Percent.to_mult percent in 6 | if Float.( < ) mult 0. || Float.( > ) mult 1. 7 | then 8 | raise_s 9 | [%message "Span.randomize: percent is out of range [0x, 1x]" (percent : Percent.t)]; 10 | let factor = 11 | Random.State.float_range random_state (1. -. mult) (Float.one_ulp `Up (1. +. mult)) 12 | in 13 | scale span factor 14 | ;; 15 | 16 | let format_decimal n tenths units = 17 | assert (tenths >= 0 && tenths < 10); 18 | if n < 10 && tenths <> 0 19 | then sprintf "%d.%d%s" n tenths units 20 | else sprintf "%d%s" n units 21 | ;; 22 | 23 | let short_string ~sign ~hr ~min ~sec ~ms ~us ~ns = 24 | let s = 25 | if hr >= 24 26 | then format_decimal (hr / 24) (Int.of_float (Float.of_int (hr % 24) /. 2.4)) "d" 27 | else if hr > 0 28 | then format_decimal hr (min / 6) "h" 29 | else if min > 0 30 | then format_decimal min (sec / 6) "m" 31 | else if sec > 0 32 | then format_decimal sec (ms / 100) "s" 33 | else if ms > 0 34 | then format_decimal ms (us / 100) "ms" 35 | else if us > 0 36 | then format_decimal us (ns / 100) "us" 37 | else sprintf "%ins" ns 38 | in 39 | match (sign : Sign.t) with 40 | | Neg -> "-" ^ s 41 | | Zero | Pos -> s 42 | ;; 43 | -------------------------------------------------------------------------------- /core/src/span_helpers.mli: -------------------------------------------------------------------------------- 1 | open! Import 2 | 3 | val randomize 4 | : 'span 5 | -> Random.State.t 6 | -> percent:Percent.t 7 | -> scale:('span -> float -> 'span) 8 | -> 'span 9 | 10 | val short_string 11 | : sign:Sign.t 12 | -> hr:int 13 | -> min:int 14 | -> sec:int 15 | -> ms:int 16 | -> us:int 17 | -> ns:int 18 | -> string 19 | -------------------------------------------------------------------------------- /core/src/stable_comparable.ml: -------------------------------------------------------------------------------- 1 | module type%template [@mode m = (global, local)] V1 = sig 2 | include Stable_module_types.S0 [@mode m] 3 | 4 | include 5 | Comparable.Stable.V1.S 6 | with type comparable := t 7 | with type comparator_witness := comparator_witness 8 | end 9 | 10 | module With_stable_witness = struct 11 | module type%template [@mode m = (global, local)] V1 = sig 12 | include Stable_module_types.With_stable_witness.S0 [@mode m] 13 | 14 | include 15 | Comparable.Stable.V1.With_stable_witness.S 16 | with type comparable := t 17 | with type comparator_witness := comparator_witness 18 | end 19 | end 20 | -------------------------------------------------------------------------------- /core/src/stable_int63able.ml: -------------------------------------------------------------------------------- 1 | open! Import 2 | 3 | module type%template [@mode m = (global, local)] S = sig 4 | include Stable_module_types.S0 [@mode m] 5 | 6 | (** [to_int63] and [of_int63_exn] encode [t] for use in wire protocols; they are 7 | intended to avoid allocation on 64-bit machines and should be implemented 8 | efficiently. [of_int63_exn (to_int63 t) = t] for all [t]; [of_int63_exn] raises for 9 | inputs not produced by [to_int63]. *) 10 | val to_int63 : t -> Int63.t 11 | 12 | val of_int63_exn : Int63.t -> t 13 | end 14 | 15 | module Without_comparator = struct 16 | module type%template [@mode m = (global, local)] S = sig 17 | include Stable_module_types.S0_without_comparator [@mode m] 18 | 19 | val to_int63 : t -> Int63.t 20 | val of_int63_exn : Int63.t -> t 21 | end 22 | end 23 | 24 | module With_stable_witness = struct 25 | module type%template [@mode m = (global, local)] S = sig 26 | include Stable_module_types.With_stable_witness.S0 [@mode m] 27 | 28 | val to_int63 : t -> Int63.t 29 | val of_int63_exn : Int63.t -> t 30 | end 31 | end 32 | -------------------------------------------------------------------------------- /core/src/stable_unit_test.mli: -------------------------------------------------------------------------------- 1 | (** The tests generated by these functors are run like any other unit tests: by the inline 2 | test runner when the functor is applied. 3 | 4 | See [stable_unit_test_intf.ml] for documentation regarding the argument module types. *) 5 | 6 | open! Import 7 | open! Stable_unit_test_intf 8 | 9 | (** We provide separate access to sexp serialization and deserialization tests because 10 | some stable types will have varying sexp serializations. Notably, Time.sexp_of_t 11 | depends on the local timezone. For such types it is still important to check that all 12 | the sexps can be deserialized correctly. *) 13 | module Make_sexp_deserialization_test (T : Arg) : sig end 14 | 15 | module Make_sexp_serialization_test (T : Arg) : sig end 16 | 17 | [%%template: 18 | [@@@mode.default m = (global, local)] 19 | 20 | module Make_bin_io_test (T : Arg [@mode m]) : sig end 21 | 22 | (** Include all of the above tests. *) 23 | module Make (T : Arg [@mode m]) : sig end] 24 | 25 | (** See [stable_unit_test_intf.ml] for documentation. *) 26 | module type Unordered_container_arg = Unordered_container_arg 27 | 28 | module Unordered_container_test = Unordered_container_test 29 | module Make_unordered_container (T : Unordered_container_arg) : sig end 30 | -------------------------------------------------------------------------------- /core/src/stable_unit_test_intf.ml: -------------------------------------------------------------------------------- 1 | (** An interface for creating unit tests to check stability of sexp and bin-io 2 | serializations *) 3 | 4 | open! Import 5 | 6 | module type%template [@mode m = (global, local)] Arg = sig 7 | type t [@@deriving sexp, (bin_io [@mode m]), (equal [@mode m])] 8 | 9 | (** [tests] is a list of (value, sexp-representation, bin-io-representation) triples. 10 | The unit tests check that the type properly serializes and de-serializes according 11 | to the given representations. *) 12 | val tests : (t * string * string) list 13 | end 14 | 15 | (** Unordered container tests are for types with serializations that will contain a 16 | certain set of elements (each represented by a single sexp or bin-io string) which may 17 | appear in any order, such as hash tables and hash sets. *) 18 | module Unordered_container_test = struct 19 | type t = 20 | { sexps : string list 21 | ; bin_io_header : string 22 | ; bin_io_elements : string list 23 | } 24 | end 25 | 26 | module type Unordered_container_arg = sig 27 | type t [@@deriving sexp, bin_io] 28 | 29 | val equal : t -> t -> bool 30 | val tests : (t * Unordered_container_test.t) list 31 | end 32 | -------------------------------------------------------------------------------- /core/src/stack.ml: -------------------------------------------------------------------------------- 1 | include Base.Stack 2 | 3 | include%template 4 | Bin_prot.Utils.Make_binable1_without_uuid [@modality portable] [@alert "-legacy"] (struct 5 | type nonrec 'a t = 'a t 6 | 7 | module Binable = List 8 | 9 | let to_binable = to_list 10 | let of_binable = of_list 11 | end) 12 | 13 | include%template 14 | Quickcheckable.Of_quickcheckable1 [@modality portable] 15 | (List) 16 | (struct 17 | type nonrec 'a t = 'a t 18 | 19 | let to_quickcheckable = to_list 20 | let of_quickcheckable = of_list 21 | end) 22 | -------------------------------------------------------------------------------- /core/src/stack.mli: -------------------------------------------------------------------------------- 1 | open! Import 2 | 3 | include module type of struct 4 | include Base.Stack 5 | end 6 | 7 | include Binable.S1 with type 'a t := 'a t 8 | include Quickcheckable.S1 with type 'a t := 'a t 9 | -------------------------------------------------------------------------------- /core/src/string_id.mli: -------------------------------------------------------------------------------- 1 | (** Like {!Identifiable}, but with [t = private string] and stable modules. *) 2 | 3 | include String_id_intf.String_id (** @inline *) 4 | -------------------------------------------------------------------------------- /core/src/substring.ml: -------------------------------------------------------------------------------- 1 | open! Import 2 | 3 | module type S = Make_substring.S 4 | 5 | include%template Make_substring.F [@modality portable] (struct 6 | type t = Bytes.t [@@deriving quickcheck] 7 | 8 | let create = Bytes.create 9 | let length = Bytes.length 10 | let get t i = Bytes.get t i 11 | 12 | module Blit = Make_substring.Blit 13 | 14 | let blit = Blit.bytes_bytes 15 | let blit_to_string = Blit.bytes_bytes 16 | let blit_to_bytes = Blit.bytes_bytes 17 | let blit_to_bigstring = Blit.bytes_bigstring 18 | let blit_from_string = Blit.string_bytes 19 | let blit_from_bigstring = Blit.bigstring_bytes 20 | end) 21 | -------------------------------------------------------------------------------- /core/src/substring.mli: -------------------------------------------------------------------------------- 1 | (** A substring is a contiguous set of characters within a string. Creating a substring 2 | does not copy. Therefore modifying the string also modifies the substring. *) 3 | 4 | module type S = Make_substring.S 5 | 6 | include S with type base = bytes (** @inline *) 7 | -------------------------------------------------------------------------------- /core/src/t.ml: -------------------------------------------------------------------------------- 1 | (** Derived from [Base.T]. Used for matching bare signatures with just a type. *) 2 | 3 | open! Import 4 | include Base.T 5 | 6 | module type T_bin = sig 7 | type t [@@deriving bin_io] 8 | end 9 | -------------------------------------------------------------------------------- /core/src/temporal-polyfill/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright 2017, 2018, 2019, 2020 ECMA International 2 | 3 | Permission to use, copy, modify, and/or distribute this software for any 4 | purpose with or without fee is hereby granted, provided that the above 5 | copyright notice and this permission notice appear in all copies. 6 | 7 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH 8 | REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY 9 | AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, 10 | INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM 11 | LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR 12 | OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR 13 | PERFORMANCE OF THIS SOFTWARE. 14 | -------------------------------------------------------------------------------- /core/src/temporal-polyfill/dune: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/janestreet/core/1a1290e5789200e2dd50a87a17774f4eb75e82c6/core/src/temporal-polyfill/dune -------------------------------------------------------------------------------- /core/src/temporal-polyfill/readme.md: -------------------------------------------------------------------------------- 1 | This bundles a polyfill available on [github](https://github.com/js-temporal/temporal-polyfill). 2 | 3 | Import and bundle generation code is located in `import`. 4 | 5 | If you need to re-bundle, cd into that dir and run the `build.sh` script: 6 | 7 | ```bash 8 | cd lib/core/src/temporal-stubs/import 9 | sh build.sh 10 | sh upload-build-data.sh 11 | ``` 12 | -------------------------------------------------------------------------------- /core/src/time.mli: -------------------------------------------------------------------------------- 1 | include Time_intf.Time 2 | -------------------------------------------------------------------------------- /core/src/time_float0.mli: -------------------------------------------------------------------------------- 1 | open! Import 2 | 3 | module Span : module type of struct 4 | include Span_float 5 | end 6 | with module Stable := Span_float.Stable 7 | and module Private := Span_float.Private 8 | 9 | module Ofday : module type of struct 10 | include Ofday_float 11 | end 12 | with module Stable := Ofday_float.Stable 13 | 14 | include 15 | Time0_intf.S 16 | with type underlying = float 17 | and module Span := Span 18 | and module Ofday := Ofday 19 | 20 | module Stable : sig 21 | module Span = Span_float.Stable 22 | module Ofday = Ofday_float.Stable 23 | end 24 | -------------------------------------------------------------------------------- /core/src/time_ns.mli: -------------------------------------------------------------------------------- 1 | (** Time module. *) 2 | 3 | include Time_ns_intf.Time_ns (** @inline *) 4 | -------------------------------------------------------------------------------- /core/src/time_ns_alternate_sexp.ml: -------------------------------------------------------------------------------- 1 | open! Import 2 | include Time_ns 3 | include Alternate_sexp 4 | -------------------------------------------------------------------------------- /core/src/time_ns_alternate_sexp.mli: -------------------------------------------------------------------------------- 1 | (** A [Time_ns] that uses its alternate sexp representation. **) 2 | 3 | open! Import 4 | 5 | include module type of struct 6 | include Time_ns 7 | end 8 | 9 | include module type of struct 10 | include Alternate_sexp 11 | end 12 | -------------------------------------------------------------------------------- /core/src/timezone.mli: -------------------------------------------------------------------------------- 1 | include Timezone_intf.Timezone (** @inline *) 2 | -------------------------------------------------------------------------------- /core/src/timezone_js_loader.mli: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | type t = 4 | { first_transition : Timezone_types.Transition.t 5 | ; remaining_transitions : Timezone_types.Transition.t list 6 | } 7 | 8 | module Load_error : sig 9 | type t = 10 | | Disabled 11 | | Platform_not_supported 12 | | Failed of exn 13 | [@@deriving sexp_of] 14 | end 15 | 16 | val load : string -> (t, Load_error.t) Result.t 17 | 18 | module For_testing : sig 19 | val disable : unit -> unit 20 | val enable : unit -> unit 21 | end 22 | 23 | module For_advanced_timezone_feature_detection : sig 24 | val should_use_timezone_js_loader 25 | : unit 26 | -> [ `Yes | `Platform_not_supported | `Disabled ] 27 | end 28 | -------------------------------------------------------------------------------- /core/src/timezone_runtime.js: -------------------------------------------------------------------------------- 1 | var dateTimeFormat = 2 | Intl 3 | && Intl.DateTimeFormat 4 | && Intl.DateTimeFormat(); 5 | var resolvedOptions = 6 | dateTimeFormat 7 | && dateTimeFormat.resolvedOptions 8 | && dateTimeFormat.resolvedOptions(); 9 | var tz = resolvedOptions && resolvedOptions.timeZone 10 | // If a timezone is available, set the TZ env variable. 11 | if (tz) { 12 | if (!globalThis.jsoo_env) 13 | globalThis.jsoo_env = {}; 14 | globalThis.jsoo_env.TZ = tz; 15 | } 16 | -------------------------------------------------------------------------------- /core/src/timezone_types.ml: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | module Regime = struct 4 | (** When used from javascript, daylight savings and abbreviation information aren't 5 | available, so on that platform, [is_dst] is always false, and [abbrv] is always the 6 | empty string. *) 7 | type t = 8 | { utc_offset_in_seconds : Int63.t 9 | ; is_dst : bool 10 | ; abbrv : string 11 | } 12 | end 13 | 14 | module Transition = struct 15 | type t = 16 | { start_time_in_seconds_since_epoch : Int63.t 17 | ; new_regime : Regime.t 18 | } 19 | end 20 | -------------------------------------------------------------------------------- /core/src/tuple.mli: -------------------------------------------------------------------------------- 1 | include Tuple_intf.Tuple 2 | -------------------------------------------------------------------------------- /core/src/type_equal.ml: -------------------------------------------------------------------------------- 1 | include Base.Type_equal 2 | 3 | module Id = struct 4 | include Id 5 | 6 | module Uid = struct 7 | module Upstream = Base.Type_equal.Id.Uid 8 | include Base.Type_equal.Id.Uid 9 | 10 | include%template 11 | Comparable.Extend_plain [@mode local] [@modality portable] 12 | (Upstream) 13 | (struct 14 | type t = Base.Type_equal.Id.Uid.t [@@deriving sexp_of] 15 | end) 16 | 17 | include%template Hashable.Make_plain [@modality portable] (Upstream) 18 | end 19 | end 20 | -------------------------------------------------------------------------------- /core/src/type_equal.mli: -------------------------------------------------------------------------------- 1 | (** This module extends {{!Base.Type_equal} [Base.Type_equal]}. *) 2 | 3 | include Type_equal_intf.Type_equal (** @inline *) 4 | -------------------------------------------------------------------------------- /core/src/type_equal_intf.ml: -------------------------------------------------------------------------------- 1 | (*_ This is just to extend Uid with the standard hashability and binability primitives *) 2 | 3 | module type Uid = sig 4 | include module type of struct 5 | include Base.Type_equal.Id.Uid 6 | end 7 | 8 | include%template 9 | Comparable.S_plain 10 | [@mode local] 11 | with type t := t 12 | and type comparator_witness := comparator_witness 13 | 14 | include Hashable.S_plain with type t := t 15 | end 16 | 17 | module type Id = sig 18 | include module type of struct 19 | include Base.Type_equal.Id 20 | end 21 | 22 | module Uid : Uid 23 | end 24 | 25 | module type Type_equal = sig 26 | (** @inline *) 27 | include module type of struct 28 | include Base.Type_equal 29 | end 30 | 31 | module Id : Id 32 | end 33 | -------------------------------------------------------------------------------- /core/src/uchar.mli: -------------------------------------------------------------------------------- 1 | (** This module extends {{!Base.Uchar} [Base.Uchar]}, adding [Comparable] and [Hashable] 2 | functionality, [bin_io] support, and [Quickcheckable] to facilitate automated testing 3 | with pseudorandom data. *) 4 | 5 | type t = Base.Uchar.t [@@deriving bin_io] 6 | 7 | (** {2 The signature included from [Base.Uchar]} *) 8 | 9 | (** @inline *) 10 | include module type of struct 11 | include Base.Uchar 12 | end 13 | with type t := t 14 | 15 | include%template 16 | Comparable.S_binable 17 | [@mode local] 18 | with type t := t 19 | and type comparator_witness := comparator_witness 20 | 21 | include Hashable.S_binable with type t := t 22 | 23 | (** {2 Quickcheck Support} *) 24 | 25 | include Quickcheckable.S with type t := t 26 | 27 | module Stable : sig 28 | module V1 : sig 29 | type nonrec t = t [@@deriving bin_io, equal ~localize, hash, sexp_grammar] 30 | 31 | include 32 | Stable_comparable.With_stable_witness.V1 33 | with type t := t 34 | with type comparator_witness = comparator_witness 35 | 36 | include Hashable.Stable.V1.With_stable_witness.S with type key := t 37 | end 38 | end 39 | -------------------------------------------------------------------------------- /core/src/uniform_array.ml: -------------------------------------------------------------------------------- 1 | open! Import 2 | include Base.Uniform_array 3 | 4 | include%template 5 | Binable.Of_binable1_without_uuid [@modality portable] [@alert "-legacy"] 6 | (Array) 7 | (struct 8 | type nonrec 'a t = 'a t 9 | 10 | let to_binable = to_array 11 | let of_binable = of_array 12 | end) 13 | 14 | include%template 15 | Quickcheckable.Of_quickcheckable1 [@modality portable] 16 | (Array) 17 | (struct 18 | type nonrec 'a t = 'a t 19 | 20 | let to_quickcheckable = to_array 21 | let of_quickcheckable = of_array 22 | end) 23 | -------------------------------------------------------------------------------- /core/src/uniform_array.mli: -------------------------------------------------------------------------------- 1 | (** This module extends {{!Base.Uniform_array} [Base.Uniform_array]} with bin_io. *) 2 | 3 | open! Import 4 | 5 | type 'a t = 'a Base.Uniform_array.t [@@deriving bin_io, quickcheck, sexp, sexp_grammar] 6 | 7 | include module type of struct 8 | include Base.Uniform_array 9 | end 10 | with type 'a t := 'a t 11 | -------------------------------------------------------------------------------- /core/src/unique_id.ml: -------------------------------------------------------------------------------- 1 | open! Import 2 | open Unique_id_intf 3 | 4 | module type Id = Id 5 | 6 | module Int () = struct 7 | include Int 8 | 9 | let current = Atomic.make zero 10 | let create () = Atomic.update_and_return current ~pure_f:[%eta1 succ] 11 | 12 | module For_testing = struct 13 | let reset_counter () = Atomic.set current zero 14 | end 15 | end 16 | 17 | module Int63 () = struct 18 | include Int63 19 | 20 | let current = Atomic.make zero 21 | let create () = Atomic.update_and_return current ~pure_f:[%eta1 succ] 22 | 23 | module For_testing = struct 24 | let reset_counter () = Atomic.set current zero 25 | end 26 | end 27 | -------------------------------------------------------------------------------- /core/src/unique_id.mli: -------------------------------------------------------------------------------- 1 | (** Functors for creating modules that mint unique identifiers. *) 2 | 3 | open! Import 4 | open Unique_id_intf 5 | 6 | module type Id = Id 7 | 8 | (** An abstract unique identifier based on ordinary OCaml integers. Be careful, this may 9 | easily overflow on 32-bit platforms! [Int63] is a safer choice for portability. 10 | 11 | [Int] is useful when one is passing unique ids to C and needs a guarantee as to their 12 | representation. [Int] is always represented as an integer, while [Int63] is either an 13 | integer (on 64-bit machines) or a pointer (on 32-bit machines). 14 | 15 | The generated ids will therefore be fast to generate and not use much memory. If you 16 | do not have very stringent requirements on the size, speed, and ordering of your IDs 17 | then you should use the UUIDM library instead, which will give you a truly unique id, 18 | even amongst different runs and different machines. *) 19 | module Int () : sig 20 | include Id with type t = private int 21 | end 22 | 23 | (** An abstract unique identifier based on 63 bit integers. *) 24 | module Int63 () : sig 25 | include Id with type t = private Int63.t 26 | end 27 | -------------------------------------------------------------------------------- /core/src/unique_id_intf.ml: -------------------------------------------------------------------------------- 1 | (** Signature for use by {{!module:Core.Unique_id} [Unique_id]}. *) 2 | 3 | open! Import 4 | open Std_internal 5 | 6 | module type Id = sig 7 | (** The sexps and strings look like integers. *) 8 | type t [@@deriving bin_io ~localize, hash, sexp, sexp_grammar, typerep] 9 | 10 | (** {b Caveat}: values created with [of_float], [of_sexp], or [of_string] may be equal 11 | to previously created values. *) 12 | include%template Comparable.S_binable [@mode local] with type t := t 13 | 14 | include Hashable.S_binable with type t := t 15 | include Intable with type t := t 16 | include Stringable with type t := t 17 | 18 | (** Always returns a value that is not equal to any other value created with [create]. *) 19 | val create : unit -> t 20 | 21 | module For_testing : sig 22 | (** Resets the counter to its default starting value. The nth call to [create] after 23 | [reset_counter] has been called has the same ID value as the nth call to [create] 24 | after the start of the program (before [reset_counter] has been called). 25 | 26 | This should only be used in testing to set up a deterministic environment when 27 | potentially running multiple tests in a row, because calling this will break the 28 | guarantee that [create] always returns a unique value. *) 29 | val reset_counter : unit -> unit 30 | end 31 | end 32 | -------------------------------------------------------------------------------- /core/src/unit.mli: -------------------------------------------------------------------------------- 1 | (** Module for the type [unit], extended from {{!Base.Unit} [Base.Unit]}. This is mostly 2 | useful for building functor arguments. *) 3 | 4 | open! Import 5 | 6 | type t = unit [@@deriving typerep] 7 | 8 | (** @inline *) 9 | include module type of struct 10 | include Base.Unit 11 | end 12 | with type t := t 13 | 14 | include%template 15 | Identifiable.S 16 | [@mode local] 17 | with type t := t 18 | and type comparator_witness := comparator_witness 19 | 20 | include Quickcheckable.S with type t := t 21 | 22 | include sig 23 | type t [@@deriving bin_io ~localize] 24 | end 25 | with type t := t 26 | 27 | module type S = sig end 28 | 29 | type m = (module S) 30 | 31 | module Stable : sig 32 | module V1 : sig 33 | type nonrec t = t [@@deriving bin_io ~localize, sexp_grammar] 34 | 35 | include Stable_module_types.With_stable_witness.S0 with type t := t 36 | end 37 | 38 | (** Zero-length bin_prot format. 39 | 40 | The default converter for the type [unit] is the V1 converter, not the V2. That's 41 | because there's an assumption that primitive types, which include [unit], are stable 42 | whether or not they say so, so we can't change the [unit] bin-io converter without 43 | breaking many stable types. *) 44 | module V2 : sig 45 | type nonrec t = t [@@deriving bin_io ~localize, equal ~localize, sexp_grammar] 46 | 47 | include%template 48 | Stable_module_types.With_stable_witness.S0 [@mode local] with type t := t 49 | end 50 | end 51 | -------------------------------------------------------------------------------- /core/src/unit_of_time.ml: -------------------------------------------------------------------------------- 1 | open! Import 2 | 3 | type t = 4 | | Nanosecond 5 | | Microsecond 6 | | Millisecond 7 | | Second 8 | | Minute 9 | | Hour 10 | | Day 11 | [@@deriving sexp, sexp_grammar, compare ~localize, enumerate, hash] 12 | -------------------------------------------------------------------------------- /core/src/unit_of_time.mli: -------------------------------------------------------------------------------- 1 | (** Represents a unit of time, e.g., that used by [Time.Span.to_string_hum]. Comparison 2 | respects Nanosecond < Microsecond < Millisecond < Second < Minute < Hour < Day. *) 3 | 4 | open! Import 5 | 6 | type t = 7 | | Nanosecond 8 | | Microsecond 9 | | Millisecond 10 | | Second 11 | | Minute 12 | | Hour 13 | | Day 14 | [@@deriving sexp, sexp_grammar, compare ~localize, enumerate, hash] 15 | -------------------------------------------------------------------------------- /core/src/validated.mli: -------------------------------------------------------------------------------- 1 | include Validated_intf.Validated (** @inline *) 2 | -------------------------------------------------------------------------------- /core/src/zone.mli: -------------------------------------------------------------------------------- 1 | include Zone_intf.Zone 2 | -------------------------------------------------------------------------------- /core/strftime.js-licence.txt: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | Copyright © 2016 Sami Samhuri, http://samhuri.net 3 | 4 | Permission is hereby granted, free of charge, to any person obtaining 5 | a copy of this software and associated documentation files (the 6 | “Software”), to deal in the Software without restriction, including 7 | without limitation the rights to use, copy, modify, merge, publish, 8 | distribute, sublicense, and/or sell copies of the Software, and to 9 | permit persons to whom the Software is furnished to do so, subject to 10 | the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be 13 | included in all copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND, 16 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 17 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 18 | NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 19 | LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 20 | OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 21 | WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 22 | -------------------------------------------------------------------------------- /core/test-bin/bin/dune: -------------------------------------------------------------------------------- 1 | (executables 2 | (modes byte exe) 3 | (names just_raise) 4 | (libraries core) 5 | (preprocess 6 | (pps ppx_jane))) 7 | -------------------------------------------------------------------------------- /core/test-bin/bin/just_raise.ml: -------------------------------------------------------------------------------- 1 | (* This executable exercises the behavior of uncaught exceptions at module init, when Core 2 | is opened. *) 3 | open! Core 4 | 5 | exception E of int [@@deriving sexp] 6 | 7 | let () = raise (E 42) 8 | -------------------------------------------------------------------------------- /core/test-bin/bin/just_raise.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test-bin/src/core_uncaught_exception_test.ml: -------------------------------------------------------------------------------- 1 | module Test_uncaught_exception = Test_uncaught_exception 2 | -------------------------------------------------------------------------------- /core/test-bin/src/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name core_uncaught_exception_test) 3 | (libraries async core expect_test_helpers_async) 4 | (preprocess 5 | (pps ppx_jane))) 6 | -------------------------------------------------------------------------------- /core/test-bin/src/test_uncaught_exception.ml: -------------------------------------------------------------------------------- 1 | open! Core 2 | open! Async 3 | open Expect_test_helpers_async 4 | 5 | let%expect_test "uncaught exception at module init" = 6 | let prog = "just_raise.exe" in 7 | (* Copied from ppx/ppx_expect/collector/check_backtraces.mll *) 8 | let is_backtrace_line line = 9 | [ "Raised at "; "Called from "; "Raised by primitive operation " ] 10 | |> List.exists ~f:(fun prefix -> String.is_prefix line ~prefix) 11 | in 12 | let%bind () = 13 | within_temp_dir 14 | ~links:[ "../bin/just_raise.exe", `In_path_as, prog ] 15 | (fun () -> 16 | let%bind (exit_status : int) = Sys.command (Sys.quote prog) in 17 | let output = [%expect.output] in 18 | print_endline [%string "%{prog} exited with status %{exit_status#Int}"]; 19 | print_endline ""; 20 | output 21 | |> String.split_lines 22 | |> List.map ~f:(fun line -> 23 | if is_backtrace_line line then "" else line) 24 | (* Don't depend on backtrace contents, which are unstable. *) 25 | |> List.remove_consecutive_duplicates ~equal:String.equal 26 | (* Don't depend on backtrace line count. *) 27 | |> List.iter ~f:print_endline; 28 | return ()) 29 | in 30 | [%expect 31 | {| 32 | just_raise.exe exited with status 2 33 | 34 | Uncaught exception: 35 | 36 | (just_raise.ml.E 42) 37 | 38 | 39 | |}]; 40 | return () 41 | ;; 42 | -------------------------------------------------------------------------------- /core/test-bin/src/test_uncaught_exception.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/binable_and_sexpable_unit_tests.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/bool_tests.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/core_gc_unit_tests.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/core_int63_unit_tests.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/core_list_unit_tests.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/core_map_unit_tests.mli: -------------------------------------------------------------------------------- 1 | (* Unit test interface intentionally blank *) 2 | -------------------------------------------------------------------------------- /core/test/core_set_unit_tests.mli: -------------------------------------------------------------------------------- 1 | (* Unit test interface intentionally blank *) 2 | -------------------------------------------------------------------------------- /core/test/core_string_unit_tests.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/deprecation.mlt: -------------------------------------------------------------------------------- 1 | module M : sig 2 | val x : unit [@@deprecated "[since 2016-07]"] 3 | end = struct 4 | let x = () 5 | end 6 | 7 | let _ = M.x 8 | 9 | [%%expect 10 | {| 11 | Line _, characters _-_: 12 | Error (alert deprecated): M.x 13 | [since 2016-07] 14 | |}] 15 | -------------------------------------------------------------------------------- /core/test/digit_string_helpers_tests.mli: -------------------------------------------------------------------------------- 1 | (*_ intentionally left blank *) 2 | -------------------------------------------------------------------------------- /core/test/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name core_test) 3 | (libraries base_container_tests base_for_tests base_test_helpers core 4 | core_test_helpers expect_test_helpers_core.expect_test_helpers_base 5 | expect_test_helpers_core expect_test_patterns expectable core_kernel.fheap 6 | unboxed.float_u unboxed.int32_u unboxed.int64_u unboxed.nativeint_u 7 | portable.test_helpers sexp_grammar_validation sexplib 8 | ppx_stable_witness.stable_witness unboxed_test_harness 9 | core_kernel.version_util) 10 | (preprocessor_deps ../src/config.h) 11 | (preprocess 12 | (pps ppx_jane ppx_bin_and_sexp_digest))) 13 | -------------------------------------------------------------------------------- /core/test/fn_for_testing.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | 3 | module type S = sig 4 | type t [@@deriving sexp_of, compare] 5 | end 6 | 7 | module type Examples = sig 8 | type t 9 | 10 | val examples : t list 11 | end 12 | 13 | module Make (Input : S) (Output : S) (Examples : Examples with type t := Input.t) = struct 14 | open Examples 15 | 16 | type t = Input.t -> Output.t 17 | 18 | let to_alist f = List.map examples ~f:(fun x -> x, f x) 19 | let compare t1 t2 = [%compare: (Input.t * Output.t) list] (to_alist t1) (to_alist t2) 20 | let sexp_of_t t = [%sexp (to_alist t : (Input.t * Output.t) list)] 21 | end 22 | -------------------------------------------------------------------------------- /core/test/fn_for_testing.mli: -------------------------------------------------------------------------------- 1 | open! Core 2 | 3 | module type S = sig 4 | type t [@@deriving sexp_of, compare] 5 | end 6 | 7 | module type Examples = sig 8 | type t 9 | 10 | val examples : t list 11 | end 12 | 13 | (** Provides [sexp_of, compare] for function types. Both work by first converting 14 | functions to a [(Input.t, Output.t) List.Assoc.t] using [Examples.examples] as the 15 | inputs. The resulting sexps and comparisons will only be complete with respect to the 16 | given [Examples.examples]. *) 17 | module Make (Input : S) (Output : S) (Examples : Examples with type t := Input.t) : 18 | S with type t = Input.t -> Output.t 19 | -------------------------------------------------------------------------------- /core/test/fqueue_tests.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | 3 | let%test_unit "Fqueue round trip via list" = 4 | Quickcheck.test 5 | (List.quickcheck_generator Int.quickcheck_generator) 6 | ~sexp_of:[%sexp_of: int list] 7 | ~f:(fun a -> 8 | let b = Fqueue.of_list a in 9 | let c = Fqueue.to_list b in 10 | let d = Fqueue.of_list c in 11 | [%test_result: int list] ~expect:a c; 12 | [%test_result: int Fqueue.t] ~expect:b d) 13 | ~examples:[ []; [ 1 ]; [ 1; 2 ]; [ 1; 2; 3 ] ] 14 | ;; 15 | -------------------------------------------------------------------------------- /core/test/fqueue_tests.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/hashtbl_unit_tests.mli: -------------------------------------------------------------------------------- 1 | include Hashtbl_unit_tests_intf.Hashtbl_unit_tests (** @inline *) 2 | -------------------------------------------------------------------------------- /core/test/hashtbl_unit_tests_intf.ml: -------------------------------------------------------------------------------- 1 | open! Core 2 | 3 | (** A subset of [Hashtbl_intf.Hashtbl]. Leaves out definitions that we do not need to test 4 | and that some implementations may not provide. *) 5 | module type Hashtbl_for_testing = sig 6 | type ('a, 'b) t [@@deriving sexp_of] 7 | 8 | include 9 | Hashtbl_intf.Creators 10 | with type ('a, 'b) t := ('a, 'b) t 11 | with type 'a key := 'a 12 | with type ('a, 'b, 'c) create_options := 13 | ('a, 'b, 'c) Hashtbl_intf.create_options_with_first_class_module 14 | 15 | (* [Creators] gives us a different create than [Hashtbl_intf.Hashtbl] does *) 16 | val create : ?growth_allowed:bool -> ?size:int -> 'a Base.Hashtbl.Key.t -> ('a, 'b) t 17 | 18 | include Hashtbl_intf.Accessors with type ('a, 'b) t := ('a, 'b) t with type 'a key := 'a 19 | include Hashtbl_intf.Multi with type ('a, 'b) t := ('a, 'b) t with type 'a key := 'a 20 | 21 | val invariant : 'a Invariant.t -> 'b Invariant.t -> ('a, 'b) t Invariant.t 22 | end 23 | 24 | module type Hashtbl_unit_tests = sig 25 | module type Hashtbl_for_testing = Hashtbl_for_testing 26 | 27 | (** Wrap this in a [let%test_module] to ensure the tests get run *) 28 | module Make (Hashtbl : Hashtbl_for_testing) : sig end 29 | end 30 | -------------------------------------------------------------------------------- /core/test/helpers/blit_helpers.mli: -------------------------------------------------------------------------------- 1 | include Blit_helpers_intf.Blit_helpers 2 | -------------------------------------------------------------------------------- /core/test/helpers/blit_helpers_intf.ml: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | module type Blittable = sig 4 | type 'a t [@@deriving quickcheck, equal, sexp_of] 5 | 6 | val length : _ t -> int 7 | val of_array : 'a array -> 'a t 8 | val to_array : 'a t -> 'a array 9 | end 10 | 11 | module M (Src : T1) (Dst : T1) = struct 12 | type 'a src = 'a Src.t 13 | type 'a dst = 'a Dst.t 14 | type sub = { sub : 'a. 'a src -> pos:int -> len:int -> 'a dst } 15 | type subo = { subo : 'a. ?pos:int -> ?len:int -> 'a src -> 'a dst } 16 | 17 | type blit = 18 | { blit : 'a. src:'a src -> src_pos:int -> dst:'a dst -> dst_pos:int -> len:int -> unit 19 | } 20 | 21 | type blito = 22 | { blito : 23 | 'a. 24 | src:'a src 25 | -> ?src_pos:int 26 | -> ?src_len:int 27 | -> dst:'a dst 28 | -> ?dst_pos:int 29 | -> unit 30 | -> unit 31 | } 32 | 33 | type unsafe_blit = 34 | { unsafe_blit : 35 | 'a. src:'a src -> src_pos:int -> dst:'a dst -> dst_pos:int -> len:int -> unit 36 | } 37 | end 38 | 39 | module type Helpers = sig 40 | module Src : T1 41 | module Dst : T1 42 | 43 | include module type of struct 44 | include M (Src) (Dst) 45 | end 46 | 47 | val test_sub : sub:sub -> unit 48 | val test_subo : subo:subo -> unit 49 | val test_blit : blit:blit -> unit 50 | val test_blito : blito:blito -> unit 51 | val test_unsafe_blit : unsafe_blit:unsafe_blit -> unit 52 | end 53 | 54 | module type Blit_helpers = sig 55 | module type Blittable = Blittable 56 | module type Helpers = Helpers 57 | 58 | module Make (Src : Blittable) (Dst : Blittable) : 59 | Helpers with module Src := Src and module Dst := Dst 60 | end 61 | -------------------------------------------------------------------------------- /core/test/helpers/core_test_helpers.ml: -------------------------------------------------------------------------------- 1 | module Blit_helpers = Blit_helpers 2 | module Blit_helpers_intf = Blit_helpers_intf 3 | module Test_container_with_local = Test_container_with_local 4 | module Test_container_with_local_intf = Test_container_with_local_intf 5 | -------------------------------------------------------------------------------- /core/test/helpers/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name core_test_helpers) 3 | (libraries base_quickcheck core 4 | expect_test_helpers_core.expect_test_helpers_base expect_test_helpers_core) 5 | (preprocess 6 | (pps ppx_jane))) 7 | -------------------------------------------------------------------------------- /core/test/helpers/test_container_with_local.mli: -------------------------------------------------------------------------------- 1 | include Test_container_with_local_intf.Test_container_with_local 2 | -------------------------------------------------------------------------------- /core/test/import.ml: -------------------------------------------------------------------------------- 1 | open! Core 2 | include Expect_test_helpers_core 3 | module Blit_helpers = Core_test_helpers.Blit_helpers 4 | module Test_container = Base_test_helpers.Test_container 5 | module Test_container_with_local = Core_test_helpers.Test_container_with_local 6 | module Variant = Variantslib.Variant 7 | 8 | let () = Dynamic.set_root Sexp.of_int_style `Underscores 9 | -------------------------------------------------------------------------------- /core/test/info_unit_tests.mli: -------------------------------------------------------------------------------- 1 | (*_ Deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/linked_queue_tests.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | open Linked_queue 3 | 4 | module%test _ = struct 5 | let m = 6 | let module M = struct 7 | type 'a u = 'a t [@@deriving bin_io] 8 | type t = int u [@@deriving bin_io] 9 | end 10 | in 11 | (module M : Binable.S with type t = M.t) 12 | ;; 13 | 14 | let test list = 15 | let t = of_list list in 16 | let bigstring = Binable.to_bigstring m t in 17 | let list' = to_list (Binable.of_bigstring m bigstring) in 18 | [%compare.equal: int list] list list' 19 | ;; 20 | 21 | let%test _ = test [] 22 | let%test _ = test [ 1 ] 23 | let%test _ = test [ 1; 2; 3 ] 24 | let%test _ = test (List.init 10_000 ~f:Fn.id) 25 | end 26 | -------------------------------------------------------------------------------- /core/test/linked_queue_tests.mli: -------------------------------------------------------------------------------- 1 | (*_ intentionally left blank *) 2 | -------------------------------------------------------------------------------- /core/test/or_error_unit_tests.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/quickcheck_unit_tests.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/sample_time_zone_file: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/janestreet/core/1a1290e5789200e2dd50a87a17774f4eb75e82c6/core/test/sample_time_zone_file -------------------------------------------------------------------------------- /core/test/std_unit_tests.ml: -------------------------------------------------------------------------------- 1 | open! Core 2 | 3 | let%test_unit "sexp_of_int respects sexp_of_int_style" = 4 | let r = Int_conversions.sexp_of_int_style in 5 | Dynamic.with_temporarily r `Underscores ~f:(fun () -> 6 | [%test_result: Sexp.t] (1234 |> [%sexp_of: int]) ~expect:(Atom "1_234")); 7 | Dynamic.with_temporarily r `No_underscores ~f:(fun () -> 8 | [%test_result: Sexp.t] (1234 |> [%sexp_of: int]) ~expect:(Atom "1234")) 9 | ;; 10 | 11 | let%test_unit "print_s is provided by Core" = assert (phys_equal print_s Core.print_s) 12 | 13 | let%expect_test "print_s default" = 14 | print_s [%sexp (List.init 30 ~f:Fn.id : int list)]; 15 | [%expect 16 | {| 17 | (0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 18 | 29) 19 | |}] 20 | ;; 21 | 22 | let%expect_test "print_s mach" = 23 | print_s ~mach:() [%sexp (List.init 30 ~f:Fn.id : int list)]; 24 | [%expect 25 | {| (0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29) |}] 26 | ;; 27 | -------------------------------------------------------------------------------- /core/test/std_unit_tests.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test-validated.mlt: -------------------------------------------------------------------------------- 1 | open! Core 2 | 3 | module Positive_int = Validated.Make (struct 4 | type t = int [@@deriving sexp] 5 | 6 | let here = [%here] 7 | 8 | let validate t = 9 | if Int.( > ) t 0 then Validate.pass else Validate.fail "must be positive" 10 | ;; 11 | end) 12 | 13 | module Negative_int = Validated.Make (struct 14 | type t = int [@@deriving sexp] 15 | 16 | let here = [%here] 17 | 18 | let validate t = 19 | if Int.( < ) t 0 then Validate.pass else Validate.fail "must be negative" 20 | ;; 21 | end) 22 | 23 | let (_ : (Positive_int.t, Negative_int.t) Type_equal.t) = T 24 | 25 | [%%expect 26 | {| 27 | Line _, characters _-_: 28 | Error: This expression has type (Positive_int.t, Positive_int.t) Type_equal.t 29 | but an expression was expected of type 30 | (Positive_int.t, Negative_int.t) Type_equal.t 31 | Type Positive_int.t = (int, Positive_int.witness) Validated.t 32 | is not compatible with type 33 | Negative_int.t = (int, Negative_int.witness) Validated.t 34 | Type Positive_int.witness is not compatible with type 35 | Negative_int.witness 36 | |}] 37 | -------------------------------------------------------------------------------- /core/test/test_am_running_test.ml: -------------------------------------------------------------------------------- 1 | open! Core 2 | open! Expect_test_helpers_core 3 | 4 | let%expect_test "[am_running_test]" = 5 | print_s [%message (am_running_test : bool)]; 6 | [%expect {| (am_running_test true) |}] 7 | ;; 8 | -------------------------------------------------------------------------------- /core/test/test_am_running_test.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_am_running_test.mlt: -------------------------------------------------------------------------------- 1 | open! Core 2 | 3 | let () = print_s [%message (am_running_test : bool)] 4 | 5 | [%%expect 6 | {| 7 | (am_running_test true) 8 | |}] 9 | -------------------------------------------------------------------------------- /core/test/test_array.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_array_local.mlt: -------------------------------------------------------------------------------- 1 | open! Core 2 | open Array 3 | 4 | (* first test that we only allow global elements *) 5 | let local_id (local_ x) = x;; 6 | 7 | let k = local_id 42 in 8 | Permissioned.create_local ~len:10 k 9 | 10 | [%%expect 11 | {| 12 | Line _, characters _-_: 13 | Error: This value escapes its region. 14 | |}] 15 | ;; 16 | 17 | (* then check that the array is indeed local *) 18 | let arr = Permissioned.create_local ~len:10 42 in 19 | ref arr 20 | 21 | [%%expect 22 | {| 23 | Line _, characters _-_: 24 | Error: This value escapes its region. 25 | |}] 26 | -------------------------------------------------------------------------------- /core/test/test_avltree.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_bag.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_bigstring.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_bigstring_safe_accessors.mli: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/janestreet/core/1a1290e5789200e2dd50a87a17774f4eb75e82c6/core/test/test_bigstring_safe_accessors.mli -------------------------------------------------------------------------------- /core/test/test_bigstring_unsafe_accessors.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_bigstring_unsafe_destroy.mli: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/janestreet/core/1a1290e5789200e2dd50a87a17774f4eb75e82c6/core/test/test_bigstring_unsafe_destroy.mli -------------------------------------------------------------------------------- /core/test/test_binable.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_blang.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_bounded_index.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_byte_units.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_char.ml: -------------------------------------------------------------------------------- 1 | open! Core 2 | open! Import 3 | open! Char 4 | 5 | module%test [@name "Caseless Comparable"] _ = struct 6 | let%test _ = 7 | Int.equal (Base.Map.find_exn (Caseless.Map.of_alist_exn [ 'a', 4; 'b', 5 ]) 'A') 4 8 | ;; 9 | 10 | let%test _ = Base.Set.mem (Caseless.Set.of_list [ 'a'; 'b' ]) 'A' 11 | let%test _ = Int.equal (Base.Set.length (Caseless.Set.of_list [ 'a'; 'A' ])) 1 12 | end 13 | 14 | module%test [@name "Caseless Hash"] _ = struct 15 | let%test _ = Int.equal (Caseless.hash 'a') (Caseless.hash 'A') 16 | end 17 | 18 | let%expect_test "of_string" = 19 | require_equal (module Char) (Char.of_string "c") 'c'; 20 | require_does_raise (fun () -> Char.of_string ""); 21 | [%expect {| (Failure "Char.of_string: \"\"") |}]; 22 | require_does_raise (fun () -> Char.of_string "too long"); 23 | [%expect {| (Failure "Char.of_string: \"too long\"") |}] 24 | ;; 25 | -------------------------------------------------------------------------------- /core/test/test_char.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_command_shape.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_container_module_types.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_date.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_day_of_week.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_deque.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_deriving_hash.ml: -------------------------------------------------------------------------------- 1 | open! Core 2 | open! Import 3 | 4 | module M1 = struct 5 | module T = struct 6 | type t = T of string 7 | end 8 | 9 | include T 10 | 11 | include 12 | Deriving_hash.Of_deriving_hash 13 | (String) 14 | (struct 15 | include T 16 | 17 | let to_repr (T s) = s 18 | end) 19 | end 20 | 21 | module M2 = struct 22 | type t = M1.t [@@deriving hash] 23 | end 24 | 25 | let%expect_test (_ [@tags "64-bits-only"]) = 26 | let s = "foo" in 27 | print_s [%sexp (String.hash s = M2.hash (T s) : bool)]; 28 | [%expect {| true |}] 29 | ;; 30 | -------------------------------------------------------------------------------- /core/test/test_deriving_hash.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_deriving_structures.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | open Stable_witness.Export 3 | 4 | (* We just want to make sure all of this compiles. *) 5 | 6 | module _ = struct 7 | type t = Set.M(Int).t [@@deriving bin_io, compare, equal, hash, sexp] 8 | end 9 | 10 | module _ : sig 11 | type t = Int.Set.t [@@deriving bin_io, compare, equal, hash, sexp, stable_witness] 12 | end = struct 13 | type t = Set.Stable.V1.M(Int.Stable.V1).t 14 | [@@deriving bin_io, compare, equal, hash, sexp, stable_witness] 15 | end 16 | 17 | module _ = struct 18 | type t0 = float Map.M(Int).t [@@deriving bin_io, compare, equal, hash, sexp] 19 | type 'a t1 = 'a Map.M(Bool).t [@@deriving bin_io, compare, equal, hash, sexp] 20 | end 21 | 22 | module _ : sig 23 | type t0 = float Int.Map.t 24 | [@@deriving bin_io, compare, equal, hash, sexp, stable_witness] 25 | 26 | type 'a t1 = 'a Bool.Map.t 27 | [@@deriving bin_io, compare, equal, hash, sexp, stable_witness] 28 | end = struct 29 | type t0 = float Map.Stable.V1.M(Int.Stable.V1).t 30 | [@@deriving bin_io, compare, equal, hash, sexp, stable_witness] 31 | 32 | type 'a t1 = 'a Map.Stable.V1.M(Bool.Stable.V1).t 33 | [@@deriving bin_io, compare, equal, hash, sexp, stable_witness] 34 | end 35 | 36 | module _ = struct 37 | type t0 = float Hashtbl.M(Int).t [@@deriving sexp] 38 | type 'a t1 = 'a Hashtbl.M(Bool).t [@@deriving sexp] 39 | end 40 | -------------------------------------------------------------------------------- /core/test/test_deriving_structures.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_doubly_linked.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_doubly_linked_bisimulation.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_error.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_fdeque.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_float.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_hash_queue.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_hexdump.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_host_and_port.ml: -------------------------------------------------------------------------------- 1 | open! Core 2 | open! Import 3 | 4 | let%expect_test "validate sexp grammar" = 5 | require_ok 6 | (Sexp_grammar_validation.validate_grammar 7 | (module struct 8 | type t = Host_and_port.Stable.V1.t [@@deriving quickcheck, sexp, sexp_grammar] 9 | end)); 10 | [%expect {| (Union (String (List (Cons String (Cons Integer Empty))))) |}] 11 | ;; 12 | -------------------------------------------------------------------------------- /core/test/test_host_and_port.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_iarray.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_identifiable.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_int63.ml: -------------------------------------------------------------------------------- 1 | open! Core 2 | open! Import 3 | open! Int63 4 | 5 | let%expect_test _ = 6 | print_string [%bin_digest: t]; 7 | [%expect {| 2b528f4b22f08e28876ffe0239315ac2 |}] 8 | ;; 9 | -------------------------------------------------------------------------------- /core/test/test_int63.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_list.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_map.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_map.mlt: -------------------------------------------------------------------------------- 1 | open Core 2 | 3 | let _ = Map.add 4 | 5 | [%%expect {| |}] 6 | 7 | let _ = String.Map.add 8 | 9 | [%%expect 10 | {| 11 | Line _, characters _-_: 12 | Error: Unbound value String.Map.add 13 | |}] 14 | 15 | module F (M : Map.S) = struct 16 | let _ = M.add 17 | end 18 | 19 | [%%expect 20 | {| 21 | Line _, characters _-_: 22 | Error: Unbound value M.add 23 | |}] 24 | 25 | module F (M : Core.Map.S_binable) = struct 26 | let _ = M.add 27 | end 28 | 29 | [%%expect 30 | {| 31 | Line _, characters _-_: 32 | Error: Unbound value M.add 33 | |}] 34 | 35 | module F (M : Core.Map.S_plain) = struct 36 | let _ = M.add 37 | end 38 | 39 | [%%expect 40 | {| 41 | Line _, characters _-_: 42 | Error: Unbound value M.add 43 | |}] 44 | -------------------------------------------------------------------------------- /core/test/test_map_interface.ml: -------------------------------------------------------------------------------- 1 | open! Core 2 | 3 | module _ : sig 4 | open Map_intf 5 | 6 | module Tree : sig 7 | type ('a, 'b, 'c) t 8 | 9 | include 10 | Creators_and_accessors_generic 11 | with type ('a, 'b, 'c) t := ('a, 'b, 'c) t 12 | with type ('a, 'b, 'c) tree := ('a, 'b, 'c) t 13 | with type 'c cmp := 'c 14 | with type 'k key := 'k 15 | with type ('a, 'b, 'c) create_options := ('a, 'b, 'c) With_comparator.t 16 | with type ('a, 'b, 'c) access_options := ('a, 'b, 'c) With_comparator.t 17 | end 18 | 19 | type ('a, 'b, 'c) t 20 | 21 | include 22 | Creators_and_accessors_generic 23 | with type ('a, 'b, 'c) t := ('a, 'b, 'c) t 24 | with type ('a, 'b, 'c) tree := ('a, 'b, 'c) Tree.t 25 | with type ('a, 'cmp, 'z) access_options := ('a, 'cmp, 'z) Without_comparator.t 26 | with type ('a, 'cmp, 'z) create_options := 27 | ('a, 'cmp, 'z) Map_intf.With_first_class_module.t 28 | with type 'k key := 'k 29 | with type 'c cmp := 'c 30 | end = 31 | Map 32 | -------------------------------------------------------------------------------- /core/test/test_map_interface.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_maybe_bound.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_md5.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_memo.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_modes.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_month.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_not_found.mlt: -------------------------------------------------------------------------------- 1 | open Core;; 2 | 3 | Not_found 4 | 5 | [%%expect 6 | {| 7 | Line _, characters _-_: 8 | Error (alert deprecated): Not_found 9 | [since 2018-02] Instead of raising [Not_found], consider using [raise_s] with an 10 | informative error message. If code needs to distinguish [Not_found] from other 11 | exceptions, please change it to handle both [Not_found] and [Not_found_s]. Then, instead 12 | of raising [Not_found], raise [Not_found_s] with an informative error message. 13 | |}] 14 | -------------------------------------------------------------------------------- /core/test/test_not_found2.mlt: -------------------------------------------------------------------------------- 1 | open Core;; 2 | 3 | Not_found 4 | 5 | [%%expect 6 | {| 7 | Line _, characters _-_: 8 | Error (alert deprecated): Not_found 9 | [since 2018-02] Instead of raising [Not_found], consider using [raise_s] with an 10 | informative error message. If code needs to distinguish [Not_found] from other 11 | exceptions, please change it to handle both [Not_found] and [Not_found_s]. Then, instead 12 | of raising [Not_found], raise [Not_found_s] with an informative error message. 13 | |}] 14 | -------------------------------------------------------------------------------- /core/test/test_nothing.ml: -------------------------------------------------------------------------------- 1 | open! Core 2 | open! Import 3 | 4 | let%expect_test "t_of_sexp" = 5 | require_does_raise (fun () -> Nothing.t_of_sexp (Sexp.List [])); 6 | [%expect 7 | {| 8 | (Of_sexp_error 9 | "Base.Nothing.t_of_sexp: trying to convert an empty type" 10 | (invalid_sexp ())) 11 | |}] 12 | ;; 13 | 14 | module%test [@name "Stable.V1"] _ = struct 15 | module Nothing = Nothing.Stable.V1 16 | 17 | let%expect_test "t_of_sexp" = 18 | require_does_raise (fun () -> Nothing.t_of_sexp (Sexp.List [])); 19 | [%expect 20 | {| 21 | (Of_sexp_error 22 | "lib/core/src/nothing.ml.Stable.V1.t_of_sexp: trying to convert an empty type" 23 | (invalid_sexp ())) 24 | |}] 25 | ;; 26 | 27 | let%expect_test _ = 28 | print_endline [%bin_and_sexp_digest: Nothing.t]; 29 | [%expect {| 4c263abcdcee45b5eb6ba02681664ded |}] 30 | ;; 31 | end 32 | -------------------------------------------------------------------------------- /core/test/test_nothing.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_option.ml: -------------------------------------------------------------------------------- 1 | open! Core 2 | open! Import 3 | open! Option 4 | 5 | module%test [@name "shrinker"] _ = struct 6 | module Shrinker = Quickcheck.Shrinker 7 | 8 | let t1 = Shrinker.create (Fn.const (Sequence.singleton 1)) 9 | 10 | let%test_unit _ = 11 | [%test_result: int option list] 12 | (Sequence.to_list (Shrinker.shrink (quickcheck_shrinker t1) None)) 13 | ~expect:[] 14 | ;; 15 | 16 | let%test_unit _ = 17 | let sort = List.sort ~compare:[%compare: int option] in 18 | let expect = [ None; Some 1 ] |> sort in 19 | let results = 20 | Shrinker.shrink (quickcheck_shrinker t1) (Some 5) |> Sequence.to_list |> sort 21 | in 22 | [%test_result: int option list] ~expect results 23 | ;; 24 | end 25 | 26 | let%expect_test "unsafe_value" = 27 | let test x = 28 | require (phys_equal x (Optional_syntax.Optional_syntax.unsafe_value (Some x))) 29 | in 30 | test 5; 31 | [%expect {| |}]; 32 | test "hello"; 33 | [%expect {| |}] 34 | ;; 35 | -------------------------------------------------------------------------------- /core/test/test_option.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_or_error.ml: -------------------------------------------------------------------------------- 1 | open! Core 2 | open! Import 3 | 4 | (* Check that the Or_error.t generator is indeed hitting both cases with non-trivial 5 | frequency. Out of 500 coin flips, the probability of getting <125 or >375 heads 6 | is about 2e-30. *) 7 | let%test_unit "generator" = 8 | let generator = [%quickcheck.generator: int Or_error.t] in 9 | Base_quickcheck.Test.with_sample_exn generator ~f:(fun sequence -> 10 | let num_ok = Sequence.take sequence 500 |> Sequence.count ~f:Or_error.is_ok in 11 | assert (125 <= num_ok && num_ok <= 375)) 12 | ;; 13 | -------------------------------------------------------------------------------- /core/test/test_or_error.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_percent.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_phys_same.ml: -------------------------------------------------------------------------------- 1 | open! Core 2 | open! Import 3 | 4 | let%test _ = phys_same 0 None 5 | let%test _ = phys_same 1 true 6 | 7 | let%test _ = 8 | let f () = "statically-allocated" in 9 | phys_same (f ()) (f ()) 10 | ;; 11 | 12 | let%test _ = 13 | let a = 1, 2 in 14 | phys_same a a 15 | ;; 16 | 17 | type thing = Obscure : _ -> thing 18 | 19 | let same_thing (Obscure a) (Obscure b) = phys_same a b 20 | 21 | let%test _ = 22 | let a = 1, 2 in 23 | same_thing (Obscure a) (Obscure a) 24 | ;; 25 | -------------------------------------------------------------------------------- /core/test/test_phys_same.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_popcount.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_printf.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | 3 | let%expect_test "collect_to_string" = 4 | let output = 5 | Printf.collect_to_string (fun { printf } -> 6 | printf "hello "; 7 | printf "%s%c" "world" '!') 8 | in 9 | print_s [%sexp (output : string)]; 10 | [%expect {| "hello world!" |}] 11 | ;; 12 | 13 | let%expect_test "collect_to_string - try to use printf after [collect_to_string] returned" 14 | = 15 | let captured_printf = Set_once.create () in 16 | let output = 17 | Printf.collect_to_string (fun { printf } -> 18 | printf "inside"; 19 | Set_once.set_exn captured_printf printf) 20 | in 21 | [%expect {| |}]; 22 | print_s [%sexp (output : string)]; 23 | [%expect {| inside |}]; 24 | Expect_test_helpers_base.require_does_raise (fun () -> 25 | (Set_once.get_exn captured_printf) "outside"); 26 | [%expect {| "[printf] used after [collect_to_string] returned" |}] 27 | ;; 28 | -------------------------------------------------------------------------------- /core/test/test_printf.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_queue.ml: -------------------------------------------------------------------------------- 1 | open! Core 2 | 3 | module%test _ : module type of Queue = struct 4 | include Base.Queue 5 | (* Base.Queue is tested separately. Here we test the additions from Core. *) 6 | 7 | open Core.Queue 8 | 9 | type nonrec 'a t = 'a t [@@deriving bin_io, quickcheck] 10 | 11 | let binary_search = binary_search 12 | let binary_search_segmented = binary_search_segmented 13 | 14 | (* Tested where instantiated using [Test_binary_searchable.Make1_and_test] *) 15 | 16 | module Stable = struct 17 | module V1 = Stable.V1 18 | 19 | include Stable_unit_test.Make (struct 20 | type nonrec t = int V1.t [@@deriving sexp, bin_io, compare] 21 | 22 | let equal = [%compare.equal: t] 23 | 24 | let tests = 25 | let manipulated = Queue.of_list [ 0; 3; 6; 1 ] in 26 | ignore (Queue.dequeue_exn manipulated : int); 27 | ignore (Queue.dequeue_exn manipulated : int); 28 | Queue.enqueue manipulated 4; 29 | [ Queue.of_list [], "()", "\000" 30 | ; Queue.of_list [ 1; 2; 6; 4 ], "(1 2 6 4)", "\004\001\002\006\004" 31 | ; manipulated, "(6 1 4)", "\003\006\001\004" 32 | ] 33 | ;; 34 | end) 35 | end 36 | end 37 | (* This signature is here to remind us to update the unit tests whenever we 38 | change [Queue]. *) 39 | -------------------------------------------------------------------------------- /core/test/test_queue.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_quickcheck_let_syntax.mlt: -------------------------------------------------------------------------------- 1 | #verbose true 2 | 3 | open! Core 4 | open! Quickcheck.Let_syntax 5 | 6 | let quickcheck_generator = 7 | let%map_open x = 8 | let%map a = of_list [ "a"; "b" ] in 9 | a ^ a 10 | in 11 | x ^ x 12 | ;; 13 | 14 | [%%expect 15 | {| 16 | val quickcheck_generator : string Base_quickcheck.Generator.t = 17 | |}] 18 | -------------------------------------------------------------------------------- /core/test/test_quickcheck_signature.ml: -------------------------------------------------------------------------------- 1 | open! Core 2 | 3 | module Foo (X : sig 4 | type t 5 | 6 | include Comparable.S with type t := t 7 | include Quickcheckable with type t := t 8 | end) = 9 | struct 10 | type t1 = Set.M(X).t [@@deriving quickcheck] 11 | type t2 = unit Map.M(X).t [@@deriving quickcheck] 12 | end 13 | -------------------------------------------------------------------------------- /core/test/test_quickcheck_signature.mli: -------------------------------------------------------------------------------- 1 | open! Core 2 | 3 | (*_ Check that the signature generated by deriving quickcheck is able to unify with the 4 | corresponding implementation. *) 5 | module Foo (X : sig 6 | type t 7 | 8 | include Comparable.S with type t := t 9 | include Quickcheckable with type t := t 10 | end) : sig 11 | type t1 = Set.M(X).t [@@deriving quickcheck] 12 | type t2 = unit Map.M(X).t [@@deriving quickcheck] 13 | end 14 | -------------------------------------------------------------------------------- /core/test/test_result.ml: -------------------------------------------------------------------------------- 1 | open! Core 2 | open! Import 3 | open! Result 4 | module%test [@name "Result.V1"] _ = Stable_unit_test.Make (Stable.V1_stable_unit_test) 5 | -------------------------------------------------------------------------------- /core/test/test_result.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_sequence.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_set_interface.ml: -------------------------------------------------------------------------------- 1 | open! Core 2 | 3 | module _ : sig 4 | open Set_intf 5 | 6 | module Tree : sig 7 | type ('a, 'b) t 8 | 9 | include 10 | Creators_and_accessors_generic 11 | with type ('a, 'b) set := ('a, 'b) t 12 | with type ('a, 'b) t := ('a, 'b) t 13 | with type ('a, 'b) tree := ('a, 'b) t 14 | with type 'a elt := 'a 15 | with type 'c cmp := 'c 16 | with type ('a, 'b, 'c) create_options := ('a, 'b, 'c) With_comparator.t 17 | with type ('a, 'b, 'c) access_options := ('a, 'b, 'c) With_comparator.t 18 | end 19 | 20 | type ('a, 'b) t 21 | 22 | include 23 | Creators_and_accessors_generic 24 | with type ('a, 'b) set := ('a, 'b) t 25 | with type ('a, 'b) t := ('a, 'b) t 26 | with type ('a, 'b) tree := ('a, 'b) Tree.t 27 | with type 'a elt := 'a 28 | with type 'a cmp := 'a 29 | with type ('a, 'cmp, 'z) create_options := 30 | ('a, 'cmp, 'z) Set_intf.With_first_class_module.t 31 | with type ('a, 'cmp, 'z) access_options := 32 | ('a, 'cmp, 'z) Set_intf.Without_comparator.t 33 | end = 34 | Set 35 | -------------------------------------------------------------------------------- /core/test/test_set_interface.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_set_once.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_sexp.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_sign.ml: -------------------------------------------------------------------------------- 1 | open! Core 2 | open! Import 3 | open! Sign 4 | 5 | let ( < ) = Poly.( < ) 6 | let ( = ) = Poly.( = ) 7 | let%test _ = compare Neg Zero < 0 && compare Zero Pos < 0 8 | let%test _ = List.for_all all ~f:(fun t -> t = (t |> to_int |> of_int)) 9 | let%test _ = List.for_all [ -1; 0; 1 ] ~f:(fun i -> i = (i |> of_int |> to_int)) 10 | -------------------------------------------------------------------------------- /core/test/test_sign.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_signal.ml: -------------------------------------------------------------------------------- 1 | open! Core 2 | open! Import 3 | open! Signal 4 | 5 | let%test_unit _ = 6 | [%test_eq: string] (to_string bus) "sigbus"; 7 | [%test_eq: string] (Sexp.to_string (sexp_of_t bus)) "sigbus"; 8 | [%test_eq: string] (Sexp.to_string (Stable.V1.sexp_of_t bus)) {|""|}; 9 | [%test_eq: string] (Sexp.to_string (Stable.V2.sexp_of_t bus)) "sigbus" 10 | ;; 11 | 12 | let%expect_test "all_posix" = 13 | print_s [%sexp (all_posix : t list)]; 14 | [%expect 15 | {| 16 | (sigabrt 17 | sigalrm 18 | sigbus 19 | sigchld 20 | sigcont 21 | sigfpe 22 | sighup 23 | sigill 24 | sigint 25 | sigkill 26 | sigpipe 27 | sigpoll 28 | sigprof 29 | sigquit 30 | sigsegv 31 | sigstop 32 | sigsys 33 | sigterm 34 | sigtrap 35 | sigtstp 36 | sigttin 37 | sigttou 38 | sigurg 39 | sigusr1 40 | sigusr2 41 | sigvtalrm 42 | sigxcpu 43 | sigxfsz 44 | sigzero) 45 | |}] 46 | ;; 47 | -------------------------------------------------------------------------------- /core/test/test_signal.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_source_code_position.ml: -------------------------------------------------------------------------------- 1 | open! Core 2 | open! Source_code_position.With_hiding 3 | 4 | let%expect_test "[to_string]" = 5 | print_endline (to_string [%here]); 6 | [%expect {| lib/core/test/test_source_code_position.ml:LINE:COL |}] 7 | ;; 8 | 9 | let%expect_test "[sexp_of_t]" = 10 | print_s [%sexp ([%here] : t)]; 11 | [%expect {| lib/core/test/test_source_code_position.ml:LINE:COL |}] 12 | ;; 13 | -------------------------------------------------------------------------------- /core/test/test_source_code_position.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_stable.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_staged.ml: -------------------------------------------------------------------------------- 1 | open! Core 2 | 3 | (* Test both bindings of [stage]/[unstage] on locals. *) 4 | let%expect_test "local" = 5 | let string = "printme" in 6 | print_endline (String.globalize (Staged.unstage (Staged.stage string))); 7 | [%expect {| printme |}]; 8 | print_endline (String.globalize (unstage (stage string))); 9 | [%expect {| printme |}] 10 | ;; 11 | -------------------------------------------------------------------------------- /core/test/test_staged.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_string.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_string_id.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_substring.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_sys.ml: -------------------------------------------------------------------------------- 1 | open! Core 2 | open! Import 3 | open! Sys.Private 4 | 5 | let%test_unit _ = 6 | [%test_eq: string] (unix_quote "") {|''|}; 7 | [%test_eq: string] (unix_quote "a ") {|'a '|}; 8 | [%test_eq: string] (unix_quote "a'") {|'a'\'''|}; 9 | [%test_eq: string] (unix_quote "a/b/+share+") {|a/b/+share+|}; 10 | [%test_eq: string] (unix_quote "x\000y") "'x\000y'" 11 | ;; 12 | -------------------------------------------------------------------------------- /core/test/test_sys.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_time.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_time_ns.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_timezone.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_timezone_full_data_protocol.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_timezone_js_loader.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_tuple.ml: -------------------------------------------------------------------------------- 1 | open! Core 2 | open! Import 3 | 4 | let%expect_test "Tuple2.sort is stable" = 5 | let test a b = 6 | let sorted = Tuple2.sort ((a, "a"), (b, "b")) ~compare:[%compare: int * _] in 7 | print_s [%sexp (sorted : (int * string) * (int * string))] 8 | in 9 | test 0 1; 10 | test 0 0; 11 | test 1 0; 12 | [%expect 13 | {| 14 | ((0 a) 15 | (1 b)) 16 | ((0 a) 17 | (0 b)) 18 | ((0 b) 19 | (1 a)) 20 | |}] 21 | ;; 22 | -------------------------------------------------------------------------------- /core/test/test_tuple.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_uchar.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_union_find.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_unit.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_unit_of_time.ml: -------------------------------------------------------------------------------- 1 | open! Core 2 | open! Import 3 | open! Unit_of_time 4 | 5 | let%test_unit "Span.Unit_of_time.t" = 6 | [%test_result: int] (compare Nanosecond Microsecond) ~expect:(-1); 7 | [%test_result: int] (compare Microsecond Millisecond) ~expect:(-1); 8 | [%test_result: int] (compare Millisecond Second) ~expect:(-1); 9 | [%test_result: int] (compare Second Minute) ~expect:(-1); 10 | [%test_result: int] (compare Minute Hour) ~expect:(-1); 11 | [%test_result: int] (compare Hour Day) ~expect:(-1) 12 | ;; 13 | -------------------------------------------------------------------------------- /core/test/test_unit_of_time.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_validate_bound.ml: -------------------------------------------------------------------------------- 1 | open! Core 2 | open Validate 3 | open Expect_test_helpers_core 4 | 5 | let print t = List.iter (errors t) ~f:print_endline 6 | 7 | let%expect_test "int bounds" = 8 | let res = 9 | name_list 10 | "foo" 11 | [ name "ok" (Int.validate_bound ~min:(Incl 0) ~max:(Incl 100) 5) 12 | ; name "incl_lower" (Int.validate_bound ~min:(Incl 0) ~max:(Incl 100) (-1)) 13 | ; name "incl_lower" (Int.validate_bound ~min:(Incl 0) ~max:(Incl 100) 0) 14 | ; name "incl_upper" (Int.validate_bound ~min:(Incl 0) ~max:(Incl 100) 101) 15 | ; name "incl_upper" (Int.validate_bound ~min:(Incl 0) ~max:(Incl 100) 100) 16 | ; name "excl_lower" (Int.validate_bound ~min:(Excl 0) ~max:(Excl 100) 0) 17 | ; name "excl_upper" (Int.validate_bound ~min:(Excl 0) ~max:(Excl 100) 100) 18 | ; name "excl_lower" (Int.validate_bound ~min:(Excl 0) ~max:(Excl 100) 1) 19 | ; name "excl_upper" (Int.validate_bound ~min:(Excl 0) ~max:(Excl 100) 99) 20 | ] 21 | in 22 | print res; 23 | [%expect 24 | {| 25 | (foo.incl_lower "value -1 < bound 0") 26 | (foo.incl_upper "value 101 > bound 100") 27 | (foo.excl_lower "value 0 <= bound 0") 28 | (foo.excl_upper "value 100 >= bound 100") 29 | |}] 30 | ;; 31 | 32 | let%expect_test "inf/nan" = 33 | let res = 34 | name_list 35 | "bar" 36 | [ name "ok" (Float.validate_bound ~min:(Incl 0.) ~max:(Incl 100.) 5.) 37 | ; name "nan" (Float.validate_bound ~min:(Incl 0.) ~max:(Incl 100.) Float.nan) 38 | ; name "inf" (Float.validate_bound ~min:(Incl 0.) ~max:(Incl 100.) Float.infinity) 39 | ] 40 | in 41 | print res; 42 | [%expect 43 | {| 44 | (bar.nan "value is NaN") 45 | (bar.inf "value is infinite") 46 | |}] 47 | ;; 48 | -------------------------------------------------------------------------------- /core/test/test_validate_bound.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/test_validated.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/type_immediacy_conv_unit_tests.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/test/type_immediacy_witness_unit_tests.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /core/top/core_install_printers.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | 3 | let printers = Pretty_printer.all () 4 | 5 | let eval_string ?(print_outcome = false) ?(err_formatter = Format.err_formatter) str = 6 | let lexbuf = Lexing.from_string str in 7 | let phrase = !Toploop.parse_toplevel_phrase lexbuf in 8 | Toploop.execute_phrase print_outcome err_formatter phrase 9 | ;; 10 | 11 | let rec install_printers = function 12 | | [] -> true 13 | | printer :: printers -> 14 | let cmd = Printf.sprintf "#install_printer %s;;" printer in 15 | eval_string cmd && install_printers printers 16 | ;; 17 | 18 | let () = 19 | if not (install_printers printers) 20 | then Format.eprintf "Problem installing Core-printers@." 21 | ;; 22 | -------------------------------------------------------------------------------- /core/top/core_top.ml: -------------------------------------------------------------------------------- 1 | module Core_install_printers = Core_install_printers 2 | -------------------------------------------------------------------------------- /core/top/core_top.mllib: -------------------------------------------------------------------------------- 1 | # OASIS_START 2 | # DO NOT EDIT (digest: d4446f978f17aa1e337a53d165c34e8e) 3 | Core_install_printers 4 | # OASIS_STOP 5 | -------------------------------------------------------------------------------- /core/top/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name core_top) 3 | (public_name core.top) 4 | (modes byte) 5 | (libraries compiler-libs.toplevel core) 6 | (preprocess no_preprocessing)) 7 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 3.17) 2 | -------------------------------------------------------------------------------- /filename_base/src/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name filename_base) 3 | (public_name core.filename_base) 4 | (libraries base) 5 | (preprocess 6 | (pps ppx_jane -require-template-extension))) 7 | -------------------------------------------------------------------------------- /filename_base/test/test_filename.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /heap_block/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (foreign_stubs 3 | (language c) 4 | (names heap_block_stubs)) 5 | (name heap_block) 6 | (public_name core.heap_block) 7 | (libraries base) 8 | (js_of_ocaml 9 | (javascript_files runtime.js)) 10 | (preprocess 11 | (pps ppx_jane)) 12 | (wasm_of_ocaml 13 | (javascript_files runtime.js) 14 | (wasm_files runtime.wat))) 15 | -------------------------------------------------------------------------------- /heap_block/heap_block.ml: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | type 'a t = 'a [@@deriving sexp_of] 4 | 5 | external is_heap_block : Stdlib.Obj.t -> bool = "core_heap_block_is_heap_block" 6 | [@@noalloc] 7 | 8 | let is_ok v = is_heap_block (Stdlib.Obj.repr v) 9 | let create v = if is_ok v then Some v else None 10 | 11 | let create_exn v = 12 | if is_ok v then v else failwith "Heap_block.create_exn called with non heap block" 13 | ;; 14 | 15 | let value t = t 16 | let bytes_per_word = Word_size.(num_bits word_size) / 8 17 | 18 | let bytes (type a) (t : a t) = 19 | (Stdlib.Obj.size (Stdlib.Obj.repr (t : a t)) + 1) * bytes_per_word 20 | ;; 21 | -------------------------------------------------------------------------------- /heap_block/heap_block_stubs.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | 4 | CAMLprim value core_heap_block_is_heap_block(value v) { 5 | return (Is_block(v) && Is_in_value_area(v) && Tag_val(v) != Lazy_tag && 6 | Tag_val(v) != Double_tag && Tag_val(v) != Forward_tag) 7 | ? Val_true 8 | : Val_false; 9 | } 10 | -------------------------------------------------------------------------------- /heap_block/runtime.js: -------------------------------------------------------------------------------- 1 | //Provides: core_heap_block_is_heap_block 2 | function core_heap_block_is_heap_block(x){ 3 | return +(x instanceof Array); 4 | } 5 | 6 | -------------------------------------------------------------------------------- /heap_block/runtime.wat: -------------------------------------------------------------------------------- 1 | ;; imported from https://github.com/ocaml-wasm/wasm_of_ocaml/issues/5 2 | (module 3 | (import "env" "lazy_tag" (global $lazy_tag i32)) 4 | (import "env" "forward_tag" (global $forward_tag i32)) 5 | 6 | (type $block (array (mut (ref eq)))) 7 | 8 | (func (export "core_heap_block_is_heap_block") 9 | (param (ref eq)) (result (ref eq)) 10 | (local $tag i32) 11 | (drop (block $not_block (result (ref eq)) 12 | (local.set $tag 13 | (i31.get_u 14 | (ref.cast (ref i31) 15 | (array.get $block 16 | (br_on_cast_fail $not_block (ref eq) (ref $block) 17 | (local.get 0)) 18 | (i32.const 0))))) 19 | (return 20 | (ref.i31 21 | (i32.eqz 22 | (i32.or 23 | (i32.eq (local.get $tag) (global.get $lazy_tag)) 24 | (i32.eq (local.get $tag) (global.get $forward_tag)))))))) 25 | (ref.i31 (i32.const 0))) 26 | ) 27 | -------------------------------------------------------------------------------- /validate/bench/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name validate_bench) 3 | (libraries base validate) 4 | (preprocess 5 | (pps ppx_jane))) 6 | -------------------------------------------------------------------------------- /validate/bench/validate_bench.ml: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | let name _t = "name" 4 | 5 | let%bench_fun "list on big list success" = 6 | let l = List.create ~len:10_000 Validate.pass in 7 | fun () -> (Validate.list ~name Fn.id l |> Sys.opaque_identity : Validate.t) |> ignore 8 | ;; 9 | 10 | let%bench_fun "list on big list mixed" = 11 | let l = 12 | List.init 10_000 ~f:(fun n -> 13 | if n % 2 = 0 then Validate.pass else Validate.fail (Printf.sprintf "fail%d" n)) 14 | in 15 | fun () -> (Validate.list ~name Fn.id l |> Sys.opaque_identity : Validate.t) |> ignore 16 | ;; 17 | 18 | let%bench_fun "list on big list failure" = 19 | let l = List.init 10_000 ~f:(fun n -> Validate.fail (Printf.sprintf "fail%d" n)) in 20 | fun () -> (Validate.list ~name Fn.id l |> Sys.opaque_identity : Validate.t) |> ignore 21 | ;; 22 | 23 | let%bench_fun "list_indexed on big list success" = 24 | let l = List.create ~len:10_000 Validate.pass in 25 | fun () -> (Validate.list_indexed Fn.id l |> Sys.opaque_identity : Validate.t) |> ignore 26 | ;; 27 | 28 | let%bench_fun "list_indexed on big list mixed" = 29 | let l = 30 | List.init 10_000 ~f:(fun n -> 31 | if n % 2 = 0 then Validate.pass else Validate.fail (Printf.sprintf "fail%d" n)) 32 | in 33 | fun () -> (Validate.list_indexed Fn.id l |> Sys.opaque_identity : Validate.t) |> ignore 34 | ;; 35 | 36 | let%bench_fun "list_indexed on big list failure" = 37 | let l = List.init 10_000 ~f:(fun n -> Validate.fail (Printf.sprintf "fail%d" n)) in 38 | fun () -> (Validate.list_indexed Fn.id l |> Sys.opaque_identity : Validate.t) |> ignore 39 | ;; 40 | -------------------------------------------------------------------------------- /validate/bench/validate_bench.mli: -------------------------------------------------------------------------------- 1 | (*_ This file is intentionally left blank. *) 2 | -------------------------------------------------------------------------------- /validate/src/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name validate) 3 | (public_name core.validate) 4 | (preprocess 5 | (pps ppx_jane)) 6 | (libraries base)) 7 | -------------------------------------------------------------------------------- /validate/test/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name validate_test) 3 | (libraries base expect_test_helpers_core validate) 4 | (preprocess 5 | (pps ppx_jane))) 6 | -------------------------------------------------------------------------------- /validate/test/test_validate.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /validate/test/validate_test.ml: -------------------------------------------------------------------------------- 1 | module Test_validate = Test_validate 2 | --------------------------------------------------------------------------------