├── .github └── workflows │ └── build.yml ├── .gitignore ├── .gitmodules ├── LICENSE ├── Makefile ├── README.md ├── _CoqProject ├── _OCamlProject ├── _builtin ├── aneris ├── algebra │ ├── ballot.v │ ├── disj_gsets.v │ └── monotone.v ├── aneris_lang │ ├── adequacy.v │ ├── adequacy_no_model.v │ ├── adequacy_trace.v │ ├── aneris_lang.v │ ├── ast.v │ ├── base_lang.v │ ├── events.v │ ├── lang.v │ ├── lib │ │ ├── assert_proof.v │ │ ├── bag_code.v │ │ ├── bag_proof.v │ │ ├── coin_flip.v │ │ ├── coin_flip_code.v │ │ ├── coin_flip_proof.v │ │ ├── inject.v │ │ ├── list_code.v │ │ ├── list_proof.v │ │ ├── lock_proof.v │ │ ├── map_code.v │ │ ├── map_proof.v │ │ ├── monitor_proof.v │ │ ├── network_util_code.v │ │ ├── network_util_proof.v │ │ ├── nodepar.v │ │ ├── nodup_code.v │ │ ├── nodup_proof.v │ │ ├── par_code.v │ │ ├── par_proof.v │ │ ├── pers_socket_proto.v │ │ ├── queue_code.v │ │ ├── queue_proof.v │ │ ├── serialization │ │ │ ├── serialization_code.v │ │ │ └── serialization_proof.v │ │ ├── set_code.v │ │ ├── set_proof.v │ │ ├── spawn_code.v │ │ ├── spawn_proof.v │ │ └── vector_clock │ │ │ ├── vector_clock_code.v │ │ │ └── vector_clock_proof.v │ ├── lifting.v │ ├── network.v │ ├── program_logic │ │ ├── aneris_adequacy.v │ │ ├── aneris_lifting.v │ │ ├── aneris_weakestpre.v │ │ ├── atomic.v │ │ ├── lightweight_atomic.v │ │ └── step_update.v │ ├── proofmode.v │ ├── resources.v │ ├── state_interp │ │ ├── messages_history.v │ │ ├── state_interp.v │ │ ├── state_interp_config_wp.v │ │ ├── state_interp_def.v │ │ ├── state_interp_events.v │ │ ├── state_interp_free_ips_coh.v │ │ ├── state_interp_gnames_coh.v │ │ ├── state_interp_local_coh.v │ │ ├── state_interp_messages_history.v │ │ ├── state_interp_messages_history_coh.v │ │ ├── state_interp_messages_resource_coh.v │ │ ├── state_interp_network_sockets_coh.v │ │ └── state_interp_socket_interp_coh.v │ └── tactics.v ├── examples │ ├── ccddb │ │ ├── ccddb_code.v │ │ ├── examples │ │ │ ├── lib.v │ │ │ ├── message_passing │ │ │ │ ├── message_passing_transitive.v │ │ │ │ ├── prog.v │ │ │ │ ├── proof_adequacy.v │ │ │ │ ├── proof_of_main.v │ │ │ │ ├── proof_of_node0.v │ │ │ │ ├── proof_of_node1.v │ │ │ │ └── proof_resources.v │ │ │ └── session_guarantees │ │ │ │ ├── mr.v │ │ │ │ ├── mw.v │ │ │ │ ├── res.v │ │ │ │ ├── ryw.v │ │ │ │ ├── server.v │ │ │ │ ├── sm_code.v │ │ │ │ ├── sm_proof.v │ │ │ │ └── wfr.v │ │ ├── instantiation │ │ │ ├── events.v │ │ │ ├── proof.v │ │ │ └── time.v │ │ ├── model │ │ │ ├── events.v │ │ │ ├── model_gst.v │ │ │ ├── model_lhst.v │ │ │ ├── model_lsec.v │ │ │ ├── model_lst.v │ │ │ ├── model_spec.v │ │ │ ├── model_update_gst.v │ │ │ ├── model_update_lhst.v │ │ │ ├── model_update_lsec.v │ │ │ ├── model_update_lst.v │ │ │ ├── model_update_prelude.v │ │ │ └── model_update_system.v │ │ ├── proof │ │ │ ├── proof_of_apply.v │ │ │ ├── proof_of_init.v │ │ │ ├── proof_of_network.v │ │ │ ├── proof_of_read.v │ │ │ └── proof_of_write.v │ │ ├── resources │ │ │ ├── base.v │ │ │ ├── resources_global_inv.v │ │ │ ├── resources_gmem.v │ │ │ ├── resources_lhst.v │ │ │ └── resources_local_inv.v │ │ ├── spec │ │ │ ├── base.v │ │ │ ├── events.v │ │ │ ├── init.v │ │ │ ├── resources.v │ │ │ ├── spec.v │ │ │ └── time.v │ │ └── spec_util.v │ ├── consensus │ │ ├── paxos_acceptor.v │ │ ├── paxos_adequacy.v │ │ ├── paxos_client.v │ │ ├── paxos_code.v │ │ ├── paxos_learner.v │ │ ├── paxos_model.v │ │ ├── paxos_prelude.v │ │ ├── paxos_proposer.v │ │ └── paxos_runner.v │ ├── crdt │ │ ├── oplib │ │ │ ├── examples │ │ │ │ ├── add_wins_set │ │ │ │ │ ├── add_wins_set_code.v │ │ │ │ │ └── add_wins_set_proof.v │ │ │ │ ├── gcounter │ │ │ │ │ ├── gcounter_code.v │ │ │ │ │ └── gcounter_proof.v │ │ │ │ ├── grow_only_set │ │ │ │ │ ├── grow_only_set_code.v │ │ │ │ │ └── grow_only_set_proof.v │ │ │ │ ├── lwwreg │ │ │ │ │ ├── lwwreg_code.v │ │ │ │ │ └── lwwreg_proof.v │ │ │ │ ├── map_comb │ │ │ │ │ ├── map_comb_code.v │ │ │ │ │ └── map_comb_proof.v │ │ │ │ ├── mvreg │ │ │ │ │ ├── mvreg_code.v │ │ │ │ │ └── mvreg_proof.v │ │ │ │ ├── pncounter │ │ │ │ │ ├── pncounter_code.v │ │ │ │ │ └── pncounter_proof.v │ │ │ │ ├── pncounter_use_case │ │ │ │ │ └── pncounter_use_case.v │ │ │ │ ├── prod_comb │ │ │ │ │ ├── prod_comb_code.v │ │ │ │ │ └── prod_comb_proof.v │ │ │ │ ├── remove_wins_set │ │ │ │ │ ├── remove_wins_set_code.v │ │ │ │ │ └── remove_wins_set_proof.v │ │ │ │ ├── table_of_counters │ │ │ │ │ ├── table_of_counters_code.v │ │ │ │ │ └── table_of_counters_proof.v │ │ │ │ ├── table_of_lwwregs │ │ │ │ │ ├── table_of_lwwregs_code.v │ │ │ │ │ └── table_of_lwwregs_proof.v │ │ │ │ └── two_p_set │ │ │ │ │ ├── two_p_set_code.v │ │ │ │ │ └── two_p_set_proof.v │ │ │ ├── oplib_code.v │ │ │ ├── proof │ │ │ │ ├── oplib_proof.v │ │ │ │ ├── params.v │ │ │ │ ├── resources.v │ │ │ │ └── time.v │ │ │ └── spec │ │ │ │ ├── events.v │ │ │ │ ├── model.v │ │ │ │ └── spec.v │ │ ├── spec │ │ │ ├── crdt_base.v │ │ │ ├── crdt_denot.v │ │ │ ├── crdt_events.v │ │ │ ├── crdt_resources.v │ │ │ ├── crdt_spec.v │ │ │ └── crdt_time.v │ │ └── statelib │ │ │ ├── examples │ │ │ └── pncounter │ │ │ │ └── counter_code.v │ │ │ ├── proof │ │ │ ├── events.v │ │ │ └── time.v │ │ │ ├── spec │ │ │ └── model.v │ │ │ └── statelib_code.v │ ├── dscm │ │ ├── clients │ │ │ ├── example1_code.v │ │ │ ├── example1_proof.v │ │ │ ├── example2_code.v │ │ │ └── example2_proof.v │ │ ├── implementations │ │ │ └── one_server │ │ │ │ ├── one_server_client_proxy_code.v │ │ │ │ ├── one_server_network_code.v │ │ │ │ ├── one_server_serialization_code.v │ │ │ │ ├── one_server_server_code.v │ │ │ │ └── proof │ │ │ │ ├── one_server_client_proxy_proof.v │ │ │ │ └── one_server_resources.v │ │ └── spec │ │ │ ├── base.v │ │ │ ├── events.v │ │ │ ├── init.v │ │ │ ├── resources.v │ │ │ ├── spec.v │ │ │ ├── stdpp_utils.v │ │ │ ├── time.v │ │ │ └── utils.v │ ├── echo │ │ ├── echo_code.v │ │ └── echo_proof.v │ ├── echo_groups │ │ ├── code.v │ │ └── proof.v │ ├── gcounter_convergence │ │ ├── crdt_adequacy.v │ │ ├── crdt_code.v │ │ ├── crdt_convergence.v │ │ ├── crdt_convergence_lemmas_defs.v │ │ ├── crdt_main_rel.v │ │ ├── crdt_model.v │ │ ├── crdt_proof.v │ │ ├── crdt_resources.v │ │ ├── crdt_runner.v │ │ └── vc.v │ ├── iterated_ping_pong │ │ ├── code.v │ │ └── proof.v │ ├── minimal_example │ │ ├── minimal_example_code.v │ │ └── minimal_example_proof.v │ ├── ping_pong │ │ └── ping_pong.v │ ├── ping_pong_done │ │ ├── ping_pong_done_code.v │ │ ├── ping_pong_done_proof.v │ │ └── ping_pong_done_runner.v │ ├── rcb │ │ ├── examples │ │ │ └── broadcast_1_2 │ │ │ │ ├── adequacy.v │ │ │ │ ├── prog.v │ │ │ │ ├── proof_broadcasting_node.v │ │ │ │ ├── proof_delivering_node.v │ │ │ │ ├── proof_of_main.v │ │ │ │ └── proof_resources.v │ │ ├── instantiation │ │ │ ├── events.v │ │ │ └── proof.v │ │ ├── model │ │ │ ├── events.v │ │ │ ├── model_gst.v │ │ │ ├── model_lhst.v │ │ │ ├── model_lsec.v │ │ │ ├── model_lst.v │ │ │ ├── model_spec.v │ │ │ ├── model_update_gst.v │ │ │ ├── model_update_lhst.v │ │ │ ├── model_update_lsec.v │ │ │ ├── model_update_lst.v │ │ │ ├── model_update_prelude.v │ │ │ └── model_update_system.v │ │ ├── proof │ │ │ ├── proof_of_broadcast.v │ │ │ ├── proof_of_deliver.v │ │ │ ├── proof_of_init.v │ │ │ └── proof_of_network.v │ │ ├── rcb_code.v │ │ ├── resources │ │ │ ├── base.v │ │ │ ├── resources_global.v │ │ │ ├── resources_global_inv.v │ │ │ ├── resources_lhst.v │ │ │ └── resources_local_inv.v │ │ ├── spec │ │ │ ├── base.v │ │ │ ├── events.v │ │ │ ├── init.v │ │ │ ├── resources.v │ │ │ └── spec.v │ │ └── util │ │ │ └── list_proof_alt.v │ ├── reliable_communication │ │ ├── client_server_code.v │ │ ├── client_server_printing.v │ │ ├── examples │ │ │ ├── dlm_db_example │ │ │ │ ├── dlm_db_example_code.v │ │ │ │ └── dlm_db_example_proof.v │ │ │ ├── hello_world │ │ │ │ ├── hello_world_code.v │ │ │ │ └── hello_world_proof.v │ │ │ ├── hello_world_2 │ │ │ │ ├── hello_world_2_code.v │ │ │ │ └── hello_world_2_proof.v │ │ │ ├── inj_elim_code.v │ │ │ ├── inj_elim_proof.v │ │ │ ├── messages_in_order │ │ │ │ ├── messages_in_order_code.v │ │ │ │ └── messages_in_order_proof.v │ │ │ ├── messages_in_order_loop │ │ │ │ ├── messages_in_order_loop_code.v │ │ │ │ └── messages_in_order_loop_proof.v │ │ │ ├── repdb_leader_followers │ │ │ │ ├── causality_example_code.v │ │ │ │ └── causality_example_proof.v │ │ │ └── sharding_examples │ │ │ │ ├── causality_example_code.v │ │ │ │ └── causality_example_proof.v │ │ ├── instantiation │ │ │ ├── instantiation_of_client_specs.v │ │ │ ├── instantiation_of_init.v │ │ │ ├── instantiation_of_resources.v │ │ │ ├── instantiation_of_send_and_recv_specs.v │ │ │ └── instantiation_of_server_specs.v │ │ ├── lib │ │ │ ├── ddb │ │ │ │ ├── ddb_code.v │ │ │ │ └── ddb_serialization_code.v │ │ │ ├── dlm │ │ │ │ ├── dlm_code.v │ │ │ │ ├── dlm_prelude.v │ │ │ │ ├── dlm_proof.v │ │ │ │ ├── dlm_resources.v │ │ │ │ └── dlm_spec.v │ │ │ ├── mt_server │ │ │ │ ├── mt_server_code.v │ │ │ │ ├── proof │ │ │ │ │ └── mt_server_proof.v │ │ │ │ ├── spec │ │ │ │ │ └── api_spec.v │ │ │ │ └── user_params.v │ │ │ ├── repdb │ │ │ │ ├── log_code.v │ │ │ │ ├── model.v │ │ │ │ ├── notes.txt │ │ │ │ ├── proof │ │ │ │ │ ├── db_resources_instance.v │ │ │ │ │ ├── follower │ │ │ │ │ │ ├── clients_at_follower_mt_user_params.v │ │ │ │ │ │ ├── proof_of_clients_handler.v │ │ │ │ │ │ ├── proof_of_init_follower.v │ │ │ │ │ │ ├── proof_of_proxy.v │ │ │ │ │ │ └── proof_of_sync_loop.v │ │ │ │ │ ├── leader │ │ │ │ │ │ ├── clients_mt_user_params.v │ │ │ │ │ │ ├── followers_mt_user_params.v │ │ │ │ │ │ ├── proof_of_client_handler.v │ │ │ │ │ │ ├── proof_of_followers_handler.v │ │ │ │ │ │ ├── proof_of_init_leader.v │ │ │ │ │ │ ├── proof_of_proxy.v │ │ │ │ │ │ └── proof_of_update_log_copy_loop.v │ │ │ │ │ ├── log_proof.v │ │ │ │ │ ├── proof_of_db_init.v │ │ │ │ │ └── repdb_serialization.v │ │ │ │ ├── repdb_code.v │ │ │ │ ├── resources │ │ │ │ │ ├── log_resources.v │ │ │ │ │ ├── ras.v │ │ │ │ │ ├── resources_def.v │ │ │ │ │ ├── resources_global_inv.v │ │ │ │ │ └── resources_local_inv.v │ │ │ │ └── spec │ │ │ │ │ ├── api_spec.v │ │ │ │ │ ├── db_params.v │ │ │ │ │ ├── events.v │ │ │ │ │ ├── ras.v │ │ │ │ │ ├── resources.v │ │ │ │ │ ├── stdpp_utils.v │ │ │ │ │ ├── time.v │ │ │ │ │ └── utils.v │ │ │ └── sharding │ │ │ │ ├── proof │ │ │ │ ├── proof_of_client_handler.v │ │ │ │ ├── proof_of_db_init.v │ │ │ │ ├── proof_of_init_client.v │ │ │ │ ├── proof_of_init_server.v │ │ │ │ ├── proof_of_init_shard.v │ │ │ │ └── proof_of_server_handler.v │ │ │ │ ├── sharding_code.v │ │ │ │ └── spec │ │ │ │ ├── api_spec.v │ │ │ │ └── resources.v │ │ ├── prelude │ │ │ ├── list_minus.v │ │ │ └── ser_inj.v │ │ ├── proof │ │ │ ├── client │ │ │ │ ├── client_resources.v │ │ │ │ ├── proof_of_client_recv_on_chan_loop.v │ │ │ │ ├── proof_of_connect.v │ │ │ │ ├── proof_of_connect_step_1.v │ │ │ │ ├── proof_of_connect_step_2.v │ │ │ │ └── proof_of_make_client_skt.v │ │ │ ├── common_protocol │ │ │ │ ├── proof_of_make_new_channel_descr.v │ │ │ │ ├── proof_of_recv_on_chan.v │ │ │ │ └── proof_of_send_from_chan_loop.v │ │ │ ├── common_user │ │ │ │ ├── proof_of_recv.v │ │ │ │ └── proof_of_send.v │ │ │ ├── notes │ │ │ └── server │ │ │ │ ├── proof_of_accept.v │ │ │ │ ├── proof_of_make_server_skt.v │ │ │ │ ├── proof_of_server_conn_step_process_data.v │ │ │ │ ├── proof_of_server_conn_step_to_establish_conn.v │ │ │ │ ├── proof_of_server_conn_step_to_open_new_conn.v │ │ │ │ ├── proof_of_server_listen.v │ │ │ │ └── server_resources.v │ │ ├── resources │ │ │ ├── chan_endpoints_resources.v │ │ │ ├── chan_session_resources.v │ │ │ ├── mono_list.v │ │ │ ├── prelude.v │ │ │ ├── session_escrow.v │ │ │ ├── socket_interp.v │ │ │ └── step_proto.v │ │ ├── spec │ │ │ ├── api_spec.v │ │ │ ├── api_symbols.v │ │ │ ├── prelude.v │ │ │ ├── proofmode.v │ │ │ ├── ras.v │ │ │ └── resources.v │ │ └── user_params.v │ ├── transaction_commit │ │ ├── Readme.md │ │ ├── gen_mono_heap.v │ │ ├── tc_model.v │ │ ├── two_phase_adequacy.v │ │ ├── two_phase_code.v │ │ ├── two_phase_prelude.v │ │ ├── two_phase_rm.v │ │ ├── two_phase_runner_code.v │ │ ├── two_phase_runner_proof.v │ │ └── two_phase_tm.v │ ├── transactional_consistency │ │ ├── aux_defs.v │ │ ├── code_api.v │ │ ├── implication_trace_util.v │ │ ├── read_committed │ │ │ ├── examples │ │ │ │ ├── commit_order │ │ │ │ │ ├── commit_order_code.v │ │ │ │ │ └── commit_order_proof.v │ │ │ │ ├── dirty_read │ │ │ │ │ ├── dirty_read_code.v │ │ │ │ │ └── dirty_read_proof.v │ │ │ │ └── trace_proof_of_concept │ │ │ │ │ ├── trace_proof_of_concept_code.v │ │ │ │ │ └── trace_proof_of_concept_proof.v │ │ │ ├── implication_proof │ │ │ │ └── si_implies_rc.v │ │ │ ├── specs │ │ │ │ ├── resources.v │ │ │ │ └── specs.v │ │ │ ├── trace │ │ │ │ ├── adequacy_trace.v │ │ │ │ └── implication_trace.v │ │ │ └── util │ │ │ │ └── util_proof.v │ │ ├── read_uncommitted │ │ │ ├── examples │ │ │ │ ├── read_own_data │ │ │ │ │ ├── read_own_data_code.v │ │ │ │ │ └── read_own_data_proof.v │ │ │ │ └── read_uncommitted_data │ │ │ │ │ ├── read_uncommitted_data_code.v │ │ │ │ │ └── read_uncommitted_data_proof.v │ │ │ ├── implication_proof │ │ │ │ └── rc_implies_ru.v │ │ │ ├── specs │ │ │ │ ├── resources.v │ │ │ │ └── specs.v │ │ │ ├── trace │ │ │ │ ├── adequacy_trace.v │ │ │ │ └── implication_trace.v │ │ │ └── util │ │ │ │ └── util_proof.v │ │ ├── resource_algebras.v │ │ ├── snapshot_isolation │ │ │ ├── examples │ │ │ │ ├── bank_transfer │ │ │ │ │ ├── bank_transfer_code.v │ │ │ │ │ └── bank_transfer_proof.v │ │ │ │ ├── causality_example │ │ │ │ │ ├── causality_example_code.v │ │ │ │ │ └── causality_example_proof.v │ │ │ │ ├── classical_example │ │ │ │ │ ├── classical_example_code.v │ │ │ │ │ └── classical_example_proof.v │ │ │ │ ├── deprecated │ │ │ │ │ ├── anomalie │ │ │ │ │ │ └── anomalie_code.v │ │ │ │ │ ├── classical_example_run │ │ │ │ │ │ ├── classical_example_run_code.v │ │ │ │ │ │ ├── classical_example_run_derived_generic_proof.v │ │ │ │ │ │ ├── classical_example_run_derived_simple_proof.v │ │ │ │ │ │ └── classical_example_run_proof.v │ │ │ │ │ ├── disjoint_reads │ │ │ │ │ │ ├── disjoint_reads_code.v │ │ │ │ │ │ └── disjoint_reads_proof.v │ │ │ │ │ └── read_your_writes │ │ │ │ │ │ ├── read_your_writes_code.v │ │ │ │ │ │ └── read_your_writes_proof.v │ │ │ │ ├── disjoint_writes │ │ │ │ │ ├── disjoint_writes_code.v │ │ │ │ │ └── disjoint_writes_proof.v │ │ │ │ ├── function_call │ │ │ │ │ ├── function_call_code.v │ │ │ │ │ └── function_call_proof.v │ │ │ │ ├── no_serializability │ │ │ │ │ ├── no_serializability_code.v │ │ │ │ │ └── no_serializability_proof.v │ │ │ │ ├── non_repeatable_read │ │ │ │ │ ├── non_repeatable_read_code.v │ │ │ │ │ └── non_repeatable_read_proof.v │ │ │ │ ├── only_reads │ │ │ │ │ ├── only_reads_code.v │ │ │ │ │ └── only_reads_proof.v │ │ │ │ ├── proof_resources.v │ │ │ │ ├── read_skew │ │ │ │ │ ├── read_skew_code.v │ │ │ │ │ └── read_skew_proof.v │ │ │ │ ├── sequential_writes │ │ │ │ │ ├── sequential_writes_code.v │ │ │ │ │ └── sequential_writes_proof.v │ │ │ │ └── write_skew │ │ │ │ │ ├── write_skew_code.v │ │ │ │ │ └── write_skew_proof.v │ │ │ ├── instantiation │ │ │ │ ├── instantiation_of_init.v │ │ │ │ ├── instantiation_of_resources.v │ │ │ │ └── snapshot_isolation_api_implementation.v │ │ │ ├── proof │ │ │ │ ├── client_proxy │ │ │ │ │ ├── proof_of_commit.v │ │ │ │ │ ├── proof_of_init_client_proxy.v │ │ │ │ │ ├── proof_of_read.v │ │ │ │ │ ├── proof_of_start.v │ │ │ │ │ └── proof_of_write.v │ │ │ │ ├── kvs_serialization.v │ │ │ │ ├── model.v │ │ │ │ ├── resources │ │ │ │ │ ├── global_invariant.v │ │ │ │ │ ├── local_invariant.v │ │ │ │ │ ├── proxy_resources.v │ │ │ │ │ ├── server_resources.v │ │ │ │ │ └── wrappers.v │ │ │ │ ├── rpc_user_params.v │ │ │ │ ├── server │ │ │ │ │ ├── proof_of_client_request_handler.v │ │ │ │ │ ├── proof_of_commit_handler.v │ │ │ │ │ ├── proof_of_init_server.v │ │ │ │ │ ├── proof_of_read_handler.v │ │ │ │ │ ├── proof_of_start_handler.v │ │ │ │ │ └── proof_of_utility_code.v │ │ │ │ └── utils.v │ │ │ ├── snapshot_isolation_code.v │ │ │ ├── specs │ │ │ │ ├── aux_defs.v │ │ │ │ ├── derived_specs.v │ │ │ │ ├── events.v │ │ │ │ ├── resources.v │ │ │ │ ├── specs.v │ │ │ │ └── time.v │ │ │ ├── trace │ │ │ │ ├── adequacy_trace.v │ │ │ │ └── implication_trace.v │ │ │ ├── util │ │ │ │ ├── util_code.v │ │ │ │ ├── util_deprecated │ │ │ │ │ └── util_proof.v │ │ │ │ └── util_proof.v │ │ │ └── wrapped_snapshot_isolation_code.v │ │ ├── state_based_model.v │ │ ├── user_params.v │ │ └── wrapped_library.v │ └── viewstamped_replication │ │ ├── vr_client_proxy_code.v │ │ ├── vr_debug.v │ │ ├── vr_network_code.v │ │ ├── vr_replica_code.v │ │ └── vr_serialization_code.v ├── lib │ ├── dfrac_oneshot.v │ ├── gen_heap_light.v │ └── singletons.v └── prelude │ ├── collect.v │ ├── gmultiset.v │ ├── gset_map.v │ ├── list.v │ ├── misc.v │ ├── quorum.v │ ├── sig_gset.v │ ├── strings.v │ └── time.v ├── coq-aneris.opam ├── documentation.pdf └── ml_sources ├── aneris_lang ├── README.md ├── ast.ml ├── dune └── lib │ ├── bag_code.ml │ ├── coin_flip_code.ml │ ├── list_code.ml │ ├── map_code.ml │ ├── network_util_code.ml │ ├── nodup_code.ml │ ├── par_code.ml │ ├── queue_code.ml │ ├── serialization │ └── serialization_code.ml │ ├── set_code.ml │ ├── spawn_code.ml │ └── vector_clock │ └── vector_clock_code.ml └── examples ├── ccddb ├── ccddb_code.ml └── dune ├── consensus ├── dune ├── paxos_code.ml ├── paxos_runner.ml └── run.sh ├── crdt ├── oplib │ ├── dune │ ├── examples │ │ ├── add_wins_set │ │ │ ├── add_wins_set_code.ml │ │ │ └── dune │ │ ├── gcounter │ │ │ ├── dune │ │ │ └── gcounter_code.ml │ │ ├── grow_only_set │ │ │ ├── dune │ │ │ └── grow_only_set_code.ml │ │ ├── lwwreg │ │ │ ├── dune │ │ │ └── lwwreg_code.ml │ │ ├── map_comb │ │ │ ├── dune │ │ │ └── map_comb_code.ml │ │ ├── mvreg │ │ │ ├── dune │ │ │ └── mvreg_code.ml │ │ ├── pncounter │ │ │ ├── dune │ │ │ └── pncounter_code.ml │ │ ├── prod_comb │ │ │ ├── dune │ │ │ └── prod_comb_code.ml │ │ ├── remove_wins_set │ │ │ ├── dune │ │ │ └── remove_wins_set_code.ml │ │ ├── table_of_counters │ │ │ ├── dune │ │ │ └── table_of_counters_code.ml │ │ ├── table_of_lwwregs │ │ │ ├── dune │ │ │ └── table_of_lwwregs_code.ml │ │ └── two_p_set │ │ │ ├── dune │ │ │ └── two_p_set_code.ml │ └── oplib_code.ml └── statelib │ ├── dune │ ├── examples │ └── pncounter │ │ ├── counter_code.ml │ │ ├── counter_runner.ml │ │ └── dune │ └── statelib_code.ml ├── dscm └── implementations │ └── one_server │ ├── dune │ ├── one_server_client_proxy_code.ml │ ├── one_server_network_code.ml │ ├── one_server_serialization_code.ml │ └── one_server_server_code.ml ├── ping_pong_done └── ping_pong_done_code.ml ├── rcb ├── dune └── rcb_code.ml ├── reliable_communication ├── client_server_code.ml ├── client_server_code.mli ├── client_server_printing.ml ├── dune ├── examples │ ├── dlm_db_example │ │ ├── dlm_db_example_code.ml │ │ └── dune │ ├── hello_world │ │ ├── dune │ │ └── hello_world_code.ml │ ├── hello_world_2 │ │ ├── dune │ │ └── hello_world_2_code.ml │ ├── messages_in_order │ │ ├── dune │ │ ├── messages_in_order_code.ml │ │ ├── messages_in_order_runner.ml │ │ └── run.sh │ ├── messages_in_order_loop │ │ ├── dune │ │ ├── messages_in_order_loop.ml │ │ └── messages_in_order_loop_code.ml │ ├── repdb_leader_followers │ │ ├── causality_example_code.ml │ │ └── dune │ └── sharding_examples │ │ ├── causality_example_code.ml │ │ └── dune └── lib │ ├── ddb │ ├── ddb_code.ml │ ├── ddb_code.mli │ ├── ddb_serialization_code.ml │ └── dune │ ├── dlm │ ├── dlm_code.ml │ ├── dlm_code.mli │ └── dune │ ├── kvls │ ├── dune │ └── kvls_code.ml │ ├── mt_server │ ├── dune │ ├── mt_server_code.ml │ └── mt_server_code.mli │ ├── repdb │ ├── dune │ ├── log_code.ml │ ├── repdb_code.ml │ └── repdb_code.mli │ └── sharding │ ├── dune │ └── sharding_code.ml ├── stenning ├── dune └── stenning_code.ml ├── transaction_commit └── two_phase_code.ml ├── transactional_consistency ├── read_committed │ └── examples │ │ ├── commit_order │ │ ├── commit_order_code.ml │ │ └── dune │ │ └── dirty_read │ │ ├── dirty_read_code.ml │ │ └── dune ├── read_uncommitted │ └── examples │ │ ├── read_own_data │ │ ├── dune │ │ └── read_own_data_code.ml │ │ └── read_uncommitted_data │ │ ├── dune │ │ └── read_uncommitted_data_code.ml └── snapshot_isolation │ ├── dune │ ├── examples │ ├── bank_transfer │ │ ├── bank_transfer_code.ml │ │ └── dune │ ├── causality_example │ │ ├── causality_example_code.ml │ │ └── dune │ ├── classical_example │ │ ├── classical_example_code.ml │ │ └── dune │ ├── deprecated │ │ ├── anomalie │ │ │ ├── anomalie_code.ml │ │ │ ├── anomalie_runner.ml │ │ │ ├── dune │ │ │ └── run.sh │ │ ├── classical_example_run │ │ │ ├── classical_example_run_code.ml │ │ │ └── dune │ │ ├── disjoint_reads │ │ │ ├── disjoint_reads_code.ml │ │ │ └── dune │ │ └── read_your_writes │ │ │ ├── dune │ │ │ └── read_your_writes_code.ml │ ├── disjoint_writes │ │ ├── disjoint_writes_code.ml │ │ └── dune │ ├── function_call │ │ ├── dune │ │ └── function_call_code.ml │ ├── no_serializability │ │ ├── dune │ │ └── no_serializability_code.ml │ ├── non_repeatable_read │ │ ├── dune │ │ └── non_repeatable_read_code.ml │ ├── only_reads │ │ ├── dune │ │ └── only_reads_code.ml │ ├── read_skew │ │ ├── dune │ │ └── read_skew_code.ml │ ├── sequential_writes │ │ ├── dune │ │ └── sequential_writes_code.ml │ └── write_skew │ │ ├── dune │ │ └── write_skew_code.ml │ ├── snapshot_isolation_code.ml │ ├── snapshot_isolation_code.mli │ └── util │ ├── dune │ └── util_code.ml └── viewstamped_replication ├── dune ├── examples ├── dune ├── observe_par_sc.ml ├── observe_par_sc2.ml └── run.sh ├── vr_client_proxy_code.ml ├── vr_debug.ml ├── vr_network_code.ml ├── vr_replica_code.ml └── vr_serialization_code.ml /.github/workflows/build.yml: -------------------------------------------------------------------------------- 1 | name: CI 2 | 3 | on: 4 | push: 5 | branches: 6 | - master 7 | pull_request: 8 | schedule: 9 | # every day at 9am UTC 10 | - cron: "0 9 * * *" 11 | 12 | jobs: 13 | build: 14 | runs-on: ubuntu-latest 15 | strategy: 16 | matrix: 17 | coq_version: 18 | - '8.17.1' 19 | max-parallel: 4 20 | # don't cancel all in-progress jobs if one matrix job fails: 21 | fail-fast: false 22 | 23 | steps: 24 | - name: Check out code 25 | uses: actions/checkout@v3 26 | with: 27 | submodules: true 28 | - uses: coq-community/docker-coq-action@v1 29 | with: 30 | coq_version: ${{ matrix.coq_version }} 31 | ocaml_version: "4.14.2-flambda" 32 | install: "" 33 | before_script: | 34 | sudo chown -R coq:coq . # workaround a permission issue 35 | script: | 36 | startGroup Build 37 | make -j2 38 | endGroup 39 | uninstall: | 40 | make clean 41 | - name: Revert permissions 42 | # to avoid a warning at cleanup time 43 | if: ${{ always() }} 44 | run: sudo chown -R 1001:116 . 45 | -------------------------------------------------------------------------------- /.gitmodules: -------------------------------------------------------------------------------- 1 | [submodule "stdpp"] 2 | path = external/stdpp 3 | url = https://gitlab.mpi-sws.org/iris/stdpp.git 4 | [submodule "iris"] 5 | path = external/iris 6 | url = https://gitlab.mpi-sws.org/iris/iris.git 7 | [submodule "record-update"] 8 | path = external/record-update 9 | url = https://github.com/tchajed/coq-record-update 10 | [submodule "paco"] 11 | path = external/paco 12 | url = https://github.com/snu-sf/paco.git 13 | [submodule "actris"] 14 | path = external/actris 15 | url = https://gitlab.mpi-sws.org/iris/actris.git 16 | [submodule "external/trillium"] 17 | path = external/trillium 18 | url = https://github.com/logsem/trillium.git 19 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2022 Aneris Team 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 13 | all 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 21 | THE SOFTWARE. 22 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | ANERIS_DIR := 'aneris' 2 | LOCAL_SRC_DIRS := $(ANERIS_DIR) 3 | SRC_DIRS := $(LOCAL_SRC_DIRS) 'external' 4 | 5 | ALL_VFILES := $(shell find $(SRC_DIRS) -name "*.v") 6 | VFILES := $(shell find $(LOCAL_SRC_DIRS) -name "*.v") 7 | 8 | COQC := coqc 9 | Q:=@ 10 | 11 | # extract global arguments for Coq from _CoqProject 12 | COQPROJECT_ARGS := $(shell sed -E -e '/^\#/d' -e 's/-arg ([^ ]*)/\1/g' _CoqProject) 13 | 14 | all: $(VFILES:.v=.vo) 15 | 16 | .coqdeps.d: $(ALL_VFILES) _CoqProject 17 | @echo "COQDEP $@" 18 | $(Q)coqdep -vos -f _CoqProject $(ALL_VFILES) > $@ 19 | 20 | # do not try to build dependencies if cleaning or just building _CoqProject 21 | ifeq ($(filter clean,$(MAKECMDGOALS)),) 22 | include .coqdeps.d 23 | endif 24 | 25 | %.vo: %.v _CoqProject | .coqdeps.d 26 | @echo "COQC $<" 27 | $(Q)$(COQC) $(COQPROJECT_ARGS) $(COQ_ARGS) -o $@ $< 28 | 29 | %.vos: %.v _CoqProject | .coqdeps.d 30 | @echo "COQC -vos $<" 31 | $(Q)$(COQC) $(COQPROJECT_ARGS) -vos $(COQ_ARGS) $< -o $@ 32 | 33 | %.vok: %.v _CoqProject | .coqdeps.d 34 | @echo "COQC -vok $<" 35 | $(Q)$(COQC) $(COQPROJECT_ARGS) -vok $(COQ_ARGS) $< -o $@ 36 | 37 | clean: 38 | @echo "CLEAN vo glob aux" 39 | $(Q)find $(SRC_DIRS) \( -name "*.vo" -o -name "*.vo[sk]" \ 40 | -o -name ".*.aux" -o -name ".*.cache" -o -name "*.glob" \) -delete 41 | $(Q)rm -f .lia.cache 42 | rm -f .coqdeps.d 43 | 44 | # project-specific targets 45 | .PHONY: build clean-aneris aneris 46 | 47 | VPATH= $(ANERIS_DIR) 48 | VPATH_FILES := $(shell find $(VPATH) -name "*.v") 49 | 50 | build: $(VPATH_FILES:.v=.vo) 51 | 52 | aneris : 53 | @$(MAKE) build VPATH=$(ANERIS_DIR) 54 | 55 | clean-local: 56 | @echo "CLEAN vo glob aux" 57 | $(Q)find $(LOCAL_SRC_DIRS) \( -name "*.vo" -o -name "*.vo[sk]" \ 58 | -o -name ".*.aux" -o -name ".*.cache" -o -name "*.glob" \) -delete 59 | 60 | clean-aneris: 61 | @$(MAKE) clean-local LOCAL_SRC_DIRS=$(ANERIS_DIR) 62 | -------------------------------------------------------------------------------- /_CoqProject: -------------------------------------------------------------------------------- 1 | -Q aneris aneris 2 | 3 | -Q external/stdpp/stdpp stdpp 4 | -Q external/stdpp/stdpp_unstable stdpp.unstable 5 | -Q external/iris/iris iris 6 | -Q external/trillium/trillium trillium 7 | -Q external/record-update/src RecordUpdate 8 | -Q external/paco/src Paco 9 | -Q external/actris/theories actris 10 | 11 | -Q external/iris/iris_deprecated iris.deprecated 12 | -Q external/iris/iris_unstable iris.unstable 13 | -Q external/iris/iris_heap_lang iris.heap_lang 14 | -Q external/trillium/fairis trillium.fairness 15 | 16 | -arg -w -arg -notation-overridden 17 | -arg -w -arg -redundant-canonical-projection 18 | -arg -w -arg -convert_concl_no_check 19 | -arg -w -arg -undeclared-scope 20 | -arg -w -arg -ambiguous-paths 21 | -arg -w -arg -ssr-search-moved 22 | -arg -w -arg -deprecated-hint-without-locality 23 | -arg -w -arg -deprecated-instance-without-locality 24 | -arg -w -arg -deprecated-typeclasses-transparency-without-locality 25 | -arg -w -arg -future-coercion-class-field 26 | -------------------------------------------------------------------------------- /_builtin: -------------------------------------------------------------------------------- 1 | ml_sources/aneris_lang/ast.ml 2 | ml_sources/aneris_lang/network.ml 3 | ml_sources/examples/viewstamped_replication/vr_debug.ml 4 | ml_sources/examples/reliable_communication/client_server_printing.ml -------------------------------------------------------------------------------- /aneris/aneris_lang/aneris_lang.v: -------------------------------------------------------------------------------- 1 | From aneris.aneris_lang Require Export lang. 2 | 3 | Canonical Structure aneris_ectxi_lang := EctxiLanguage head_step config_step locale_of aneris_lang_mixin. 4 | Canonical Structure aneris_ectx_lang := EctxLanguageOfEctxi aneris_ectxi_lang. 5 | Canonical Structure aneris_lang := LanguageOfEctx aneris_ectx_lang. 6 | -------------------------------------------------------------------------------- /aneris/aneris_lang/base_lang.v: -------------------------------------------------------------------------------- 1 | From aneris.aneris_lang Require Export lang. 2 | 3 | Canonical Structure base_ectxi_lang := EctxiLanguage base_lang.head_step base_config_step base_lang.locale_of base_mixin. 4 | Canonical Structure base_ectx_lang := EctxLanguageOfEctxi base_ectxi_lang. 5 | Canonical Structure base_lang := LanguageOfEctx base_ectx_lang. 6 | -------------------------------------------------------------------------------- /aneris/aneris_lang/lib/assert_proof.v: -------------------------------------------------------------------------------- 1 | From iris.proofmode Require Import tactics. 2 | From stdpp Require Import binders. 3 | From aneris.aneris_lang Require Import lang tactics proofmode. 4 | From aneris.aneris_lang.program_logic Require Import aneris_lifting. 5 | Import ast. 6 | 7 | 8 | Section library. 9 | Context `{dG : anerisG Mdl Σ}. 10 | 11 | Lemma wp_assert ip E (Φ : val → iProp Σ) e : 12 | WP e @[ip] E {{ v, ⌜v = #true⌝ ∧ ▷ Φ #() }} -∗ WP assert: e @[ip] E {{ Φ }}. 13 | Proof. 14 | iIntros "HΦ". rewrite /assert /=. 15 | wp_pures. 16 | wp_apply (aneris_wp_wand with "HΦ"). 17 | iIntros (v) "[% H]"; subst. by wp_if. 18 | Qed. 19 | 20 | End library. 21 | -------------------------------------------------------------------------------- /aneris/aneris_lang/lib/bag_code.v: -------------------------------------------------------------------------------- 1 | (* This file is automatically generated from the OCaml source file 2 | /ml_sources/aneris_lang/lib/bag_code.ml *) 3 | 4 | From aneris.aneris_lang Require Import ast. 5 | 6 | Definition newbag : val := 7 | λ: <>, let: "l" := ref NONE in 8 | let: "v" := newlock #() in 9 | ("l", "v"). 10 | 11 | Definition insert : val := 12 | λ: "x" "e", 13 | let: "l" := Fst "x" in 14 | let: "lock" := Snd "x" in 15 | acquire "lock";; 16 | "l" <- (SOME ("e", ! "l"));; 17 | release "lock". 18 | 19 | Definition remove : val := 20 | λ: "x", 21 | let: "l" := Fst "x" in 22 | let: "lock" := Snd "x" in 23 | acquire "lock";; 24 | let: "r" := ! "l" in 25 | let: "res" := match: "r" with 26 | NONE => NONE 27 | | SOME "p" => "l" <- (Snd "p");; 28 | SOME (Fst "p") 29 | end in 30 | release "lock";; 31 | "res". 32 | -------------------------------------------------------------------------------- /aneris/aneris_lang/lib/coin_flip.v: -------------------------------------------------------------------------------- 1 | From iris.base_logic.lib Require Export invariants. 2 | From aneris.aneris_lang Require Import lang tactics proofmode. 3 | 4 | Definition coin_flip : val := 5 | λ: <>, let: "l" := ref #true in Fork ("l" <- #false);; !"l". 6 | 7 | Section proof. 8 | Context `{!anerisG Mdl Σ}. 9 | 10 | Lemma coin_flip_spec ip : 11 | {{{ True }}} coin_flip #() @[ip] {{{ (b : bool), RET #b; True }}}. 12 | Proof. 13 | iIntros (Φ) "_ HΦ". 14 | wp_lam. wp_alloc l as "Hl". wp_let. 15 | pose proof (nroot .@ "rnd") as rndN. 16 | iMod (inv_alloc rndN _ (∃ (b : bool), l ↦[ip] #b)%I with "[Hl]") as "#Hinv"; 17 | first by eauto. 18 | wp_apply aneris_wp_fork; iSplitL. 19 | - iModIntro. wp_seq. iInv rndN as (?) "?". wp_load. 20 | iSplitR "HΦ"; first by eauto. by iApply "HΦ". 21 | - iModIntro. iInv rndN as (?) "?". wp_store; eauto. 22 | Qed. 23 | 24 | End proof. 25 | -------------------------------------------------------------------------------- /aneris/aneris_lang/lib/coin_flip_code.v: -------------------------------------------------------------------------------- 1 | (* This file is automatically generated from the OCaml source file 2 | /ml_sources/aneris_lang/lib/coin_flip_code.ml *) 3 | 4 | From aneris.aneris_lang Require Import ast. 5 | 6 | Definition coin_flip : val := 7 | λ: <>, let: "l" := ref #true in 8 | Fork (#();; 9 | "l" <- #false);; 10 | ! "l". 11 | -------------------------------------------------------------------------------- /aneris/aneris_lang/lib/coin_flip_proof.v: -------------------------------------------------------------------------------- 1 | From iris.base_logic.lib Require Import invariants. 2 | From aneris.aneris_lang Require Import lang tactics proofmode. 3 | From aneris.aneris_lang Require Export coin_flip_code. 4 | 5 | Section proof. 6 | Context `{!anerisG Mdl Σ}. 7 | 8 | Lemma coin_flip_spec ip : 9 | {{{ True }}} coin_flip #() @[ip] {{{ (b : bool), RET #b; True }}}. 10 | Proof. 11 | iIntros (Φ) "_ HΦ". 12 | wp_lam. wp_alloc l as "Hl". wp_let. 13 | pose proof (nroot .@ "rnd") as rndN. 14 | iMod (inv_alloc rndN _ (∃ (b : bool), l ↦[ip] #b)%I with "[Hl]") as "#Hinv"; 15 | first by eauto. 16 | wp_apply aneris_wp_fork; iSplitL. 17 | - iModIntro. wp_seq. iInv rndN as (?) "?". wp_load. 18 | iSplitR "HΦ"; first by eauto. by iApply "HΦ". 19 | - iModIntro. wp_pures. iInv rndN as (?) "?". wp_store; eauto. 20 | Qed. 21 | 22 | End proof. 23 | -------------------------------------------------------------------------------- /aneris/aneris_lang/lib/nodepar.v: -------------------------------------------------------------------------------- 1 | From iris.base_logic.lib Require Export invariants. 2 | From iris.proofmode Require Import tactics. 3 | From iris.algebra Require Import excl. 4 | From aneris.aneris_lang Require Export lang tactics proofmode. 5 | Set Default Proof Using "Type". 6 | 7 | Notation "( ip1 ; e1 ) ||| ( ip2 ; e2 )" := 8 | (Start ip2 e2, Start ip1 e1)%E. 9 | 10 | Section proof. 11 | Context `{dG : !anerisG Mdl Σ}. 12 | 13 | Lemma par_spec Φ1 Φ2 P1 P2 ip1 ip2 e1 e2 : 14 | P1 ≠ ∅ ∧ P2 ≠ ∅ → 15 | Φ1 ∗ Φ2 ∗ 16 | free_ip ip1 ∗ free_ip ip2 ∗ 17 | ((Φ1 -∗ free_ports ip1 P1 -∗ WP e1 @[ip1] {{ _, True }}) ∗ 18 | (Φ2 -∗ free_ports ip2 P2 -∗ WP e2 @[ip2] {{ _, True }}))%I ⊢ 19 | WP ((ip1; e1) ||| (ip2; e2)) @["system"] {{ _, True }}. 20 | Proof. 21 | iIntros ([HP1 HP2]) "(HΦ1 & HΦ2 & HIP1 & HIP2 & Hwp1 & Hwp2)". 22 | wp_apply (aneris_wp_start P1 with "[-]"). iFrame. 23 | iSplitR "HΦ1 Hwp1"; last first. 24 | { iNext. iIntros "Hp". iApply ("Hwp1" with "HΦ1 Hp"). } 25 | iNext. simpl. 26 | wp_apply (aneris_wp_start with "[-]"). iFrame. 27 | iSplitR "HΦ2 Hwp2"; last first. 28 | { iNext. iIntros "Hp". iApply ("Hwp2" with "HΦ2 Hp"). } 29 | iNext. by wp_pures. 30 | Qed. 31 | 32 | End proof. 33 | -------------------------------------------------------------------------------- /aneris/aneris_lang/lib/par_code.v: -------------------------------------------------------------------------------- 1 | (* This file is automatically generated from the OCaml source file 2 | /ml_sources/aneris_lang/lib/par_code.ml *) 3 | 4 | From aneris.aneris_lang Require Import ast. 5 | From aneris.aneris_lang.lib Require Import spawn_code. 6 | 7 | Definition par : val := 8 | λ: "e1" "e2", 9 | let: "handle" := spawn "e1" in 10 | let: "v2" := "e2" #() in 11 | let: "v1" := join "handle" in 12 | ("v1", "v2"). 13 | 14 | Notation "e1 ||| e2" := (par (λ: <>, e1)%E (λ: <>, e2)%E) : expr_scope. 15 | 16 | Notation "e1 ||| e2" := (par (λ: <>, e1)%V (λ: <>, e2)%V) : val_scope. 17 | -------------------------------------------------------------------------------- /aneris/aneris_lang/lib/set_code.v: -------------------------------------------------------------------------------- 1 | (* This file is automatically generated from the OCaml source file 2 | /ml_sources/aneris_lang/lib/set_code.ml *) 3 | 4 | From aneris.aneris_lang Require Import ast. 5 | From aneris.aneris_lang.lib Require Import list_code. 6 | 7 | Definition set_empty : val := λ: <>, []. 8 | 9 | Definition set_add : val := 10 | λ: "x" "s", (if: list_mem "x" "s" 11 | then "s" 12 | else "x" :: "s"). 13 | 14 | Notation "{[ x ]}" := (set_add x (set_empty #())) (at level 1, format "{[ x ]}") : expr_scope. 15 | 16 | Notation "{[ x ; y ; .. ; z ]}" := 17 | (set_add x (set_add y .. (set_add z (set_empty #())) ..)) : expr_scope. 18 | 19 | Definition set_mem := list_mem. 20 | 21 | Definition set_iter := list_iter. 22 | 23 | Definition set_foldl := list_fold. 24 | 25 | Definition set_forall := list_forall. 26 | 27 | Definition set_cardinal := list_length. 28 | 29 | Definition set_subseteq : val := 30 | λ: "x" "y", list_forall (λ: "e", set_mem "e" "y") "x". 31 | 32 | Definition set_equal : val := 33 | λ: "x" "y", (set_subseteq "x" "y") && (set_subseteq "y" "x"). 34 | -------------------------------------------------------------------------------- /aneris/aneris_lang/lib/spawn_code.v: -------------------------------------------------------------------------------- 1 | (* This file is automatically generated from the OCaml source file 2 | /ml_sources/aneris_lang/lib/spawn_code.ml *) 3 | 4 | From aneris.aneris_lang Require Import ast. 5 | 6 | Definition spawn : val := 7 | λ: "f", let: "c" := ref NONE in 8 | Fork (#();; 9 | "c" <- (SOME ("f" #())));; 10 | "c". 11 | 12 | Definition join : val := 13 | rec: "join" "c" := 14 | match: ! "c" with 15 | NONE => "join" "c" 16 | | SOME "x" => "x" 17 | end. 18 | -------------------------------------------------------------------------------- /aneris/aneris_lang/state_interp/state_interp_gnames_coh.v: -------------------------------------------------------------------------------- 1 | From stdpp Require Import fin_maps gmap. 2 | From aneris.aneris_lang Require Import aneris_lang network resources. 3 | From aneris.aneris_lang.state_interp Require Import state_interp_def. 4 | From RecordUpdate Require Import RecordSet. 5 | Set Default Proof Using "Type". 6 | 7 | Import uPred. 8 | Import RecordSetNotations. 9 | 10 | Section state_interpretation. 11 | Context `{!anerisG Mdl Σ}. 12 | 13 | (** gnames_coh *) 14 | Lemma gnames_coh_singleton ip γs h Sn : 15 | gnames_coh {[ip:=γs]} {[ip:=h]} {[ip:=Sn]}. 16 | Proof. rewrite /gnames_coh !dom_singleton_L //. Qed. 17 | 18 | Lemma gnames_coh_valid γm H S ip : 19 | H !! ip = None → 20 | gnames_coh γm H S → 21 | γm !! ip = None. 22 | Proof. rewrite -!not_elem_of_dom => _ [-> _] //. Qed. 23 | 24 | Lemma gnames_coh_alloc_node γm H S ip γn σh σs : 25 | gnames_coh γm H S → 26 | gnames_coh (<[ip:=γn]> γm) (<[ip:=σh]> H) (<[ip:=σs]> S). 27 | Proof. rewrite /gnames_coh. set_solver. Qed. 28 | 29 | Lemma gnames_coh_update_heap n γm H S h h' : 30 | H !! n = Some h → 31 | gnames_coh γm H S → 32 | gnames_coh γm (<[n:=h']> H) S. 33 | Proof. 34 | intros ?%elem_of_dom_2 [? ?]. 35 | rewrite /gnames_coh dom_insert_L subseteq_union_1_L //=. 36 | set_solver. 37 | Qed. 38 | 39 | Lemma gnames_coh_update_sockets n γm H S Sn Sn' : 40 | S !! n = Some Sn → 41 | gnames_coh γm H S → 42 | gnames_coh γm H (<[n:=Sn']> S). 43 | Proof. 44 | intros ?%elem_of_dom_2 [? ?]. 45 | rewrite /gnames_coh dom_insert_L subseteq_union_1_L //=. 46 | set_solver. 47 | Qed. 48 | 49 | End state_interpretation. 50 | -------------------------------------------------------------------------------- /aneris/examples/ccddb/examples/lib.v: -------------------------------------------------------------------------------- 1 | From iris.base_logic.lib Require Import invariants. 2 | From iris.proofmode Require Import tactics. 3 | From aneris.aneris_lang Require Import lang network tactics proofmode. 4 | From aneris.prelude Require Import misc. 5 | From aneris.examples.ccddb Require Import spec spec_util. 6 | 7 | Section helpers. 8 | Context `{!anerisG Mdl Σ, !DB_params, !DB_time, !DB_events, 9 | !Maximals_Computing, !DB_resources Mdl Σ}. 10 | 11 | Definition repeat_read_until : val := 12 | λ: "rd" "k" "v", 13 | (rec: "loop" <> := 14 | if: ("rd" "k") = SOME "v" 15 | then #() 16 | else "loop" #()) #(). 17 | 18 | Opaque ip_of_address. 19 | 20 | Lemma repeat_read_until_spec k s v i z rd : 21 | DB_addresses !! i = Some z → 22 | read_spec rd i z -∗ 23 | {{{ Seen i s }}} 24 | repeat_read_until rd #k v @[ip_of_address z] 25 | {{{ s' e, RET #(); 26 | ⌜s ⊆ s'⌝ ∗ Seen i s' ∗ 27 | ⌜AE_val e = v⌝ ∗ ⌜e ∈ Maximals (restrict_key k s')⌝ ∗ 28 | OwnMemSnapshot k {[erasure e]} ∗ ⌜e = Observe (restrict_key k s')⌝ 29 | }}}. 30 | Proof. 31 | iIntros (DB_addr) "#Hrd". 32 | iIntros (Φ) "!# #Hs HΦ". 33 | rewrite /repeat_read_until. do 6 wp_pure _. 34 | iLöb as "IH" forall (Φ). 35 | wp_pures. wp_bind (rd _). 36 | wp_apply ("Hrd" with "[//] [$Hs //]"). 37 | iIntros (w). iDestruct 1 as (s' ?) "(Hs' & [(-> & %) | H]) /=". 38 | { do 2 wp_pure _. by iApply "IH". } 39 | iDestruct "H" as (u e) "(-> & % & % & HQ)". 40 | wp_pure _. case_bool_decide; wp_pure _; [|by iApply "IH"]. 41 | iApply "HΦ"; simplify_eq; auto. 42 | Qed. 43 | 44 | End helpers. 45 | 46 | Arguments repeat_read_until : simpl never. 47 | -------------------------------------------------------------------------------- /aneris/examples/ccddb/examples/message_passing/prog.v: -------------------------------------------------------------------------------- 1 | From aneris.aneris_lang Require Import lang network. 2 | From aneris.examples.ccddb.spec Require Import base init. 3 | From aneris.examples.ccddb.examples Require Import lib. 4 | From aneris.aneris_lang.lib.serialization Require Import serialization_proof. 5 | 6 | Definition z0 := SocketAddressInet "0.0.0.0" 80. 7 | Definition z1 := SocketAddressInet "0.0.0.1" 80. 8 | Definition dbs : val := InjRV (#z0, (InjRV (#z1, InjLV #()))). 9 | 10 | Section Node0. 11 | Context `{!DB_init_function}. 12 | 13 | Definition z0_prog : expr := λ: "wr", 14 | "wr" #"x" #37;; 15 | "wr" #"y" #1. 16 | 17 | Definition z0_node : expr := 18 | λ: "dbs", 19 | let: "p" := init "dbs" #0 in 20 | let: "rd" := Fst "p" in 21 | let: "wr" := Snd "p" in 22 | z0_prog "wr". 23 | 24 | End Node0. 25 | 26 | Section Node1. 27 | 28 | Context `{!DB_init_function}. 29 | 30 | Definition z1_prog : expr := λ: "rd", 31 | repeat_read_until "rd" #"y" #1;; 32 | let: "r" := "rd" #"x" in 33 | assert: "r" = SOMEV #37;; 34 | "r". 35 | 36 | Definition z1_node : expr := 37 | λ: "dbs", 38 | let: "p" := init "dbs" #1 in 39 | let: "rd" := Fst "p" in 40 | let: "wr" := Snd "p" in 41 | z1_prog "rd". 42 | 43 | End Node1. 44 | 45 | Section Main. 46 | 47 | Context `{!DB_init_function}. 48 | 49 | Definition main : expr := 50 | Start "0.0.0.0" (z0_node dbs) ;; 51 | Start "0.0.0.1" (z1_node dbs). 52 | 53 | End Main. 54 | 55 | Program Instance myparams : DB_params := 56 | {| DB_addresses := [z0; z1]; 57 | DB_keys := {["x"; "y"]}; 58 | DB_InvName := nroot .@ "dbinv"; 59 | DB_serialization := int_serialization; 60 | |}. 61 | Next Obligation. 62 | repeat constructor; set_solver. 63 | Qed. 64 | -------------------------------------------------------------------------------- /aneris/examples/ccddb/examples/message_passing/proof_resources.v: -------------------------------------------------------------------------------- 1 | From iris.algebra Require Import excl. 2 | From iris.base_logic.lib Require Import invariants. 3 | From iris.proofmode Require Import tactics. 4 | From aneris.aneris_lang Require Import 5 | lang network tactics proofmode lifting adequacy. 6 | From aneris.aneris_lang.lib.serialization Require Import serialization_proof. 7 | From aneris.examples.ccddb.spec Require Import spec. 8 | From aneris.examples.ccddb Require Import spec_util. 9 | From aneris.examples.ccddb.examples Require Import lib. 10 | From aneris.examples.ccddb.examples.message_passing Require Import prog. 11 | 12 | 13 | Class mpG Σ := MPG { mp_tokG :> inG Σ (exclR unitO) }. 14 | Definition mpΣ : gFunctors := #[GFunctor (exclR unitO)]. 15 | 16 | Instance subG_mpΣ {Σ} : subG mpΣ Σ → mpG Σ. 17 | Proof. solve_inG. Qed. 18 | 19 | Section Resources. 20 | Context `{!anerisG Mdl Σ, !DB_time, !DB_events, !DB_resources Mdl Σ, 21 | !Maximals_Computing, !mpG Σ}. 22 | 23 | Definition token (γ : gname) : iProp Σ := own γ (Excl ()). 24 | 25 | Lemma token_exclusive (γ : gname) : token γ -∗ token γ -∗ False. 26 | Proof. iIntros "H1 H2". by iDestruct (own_valid_2 with "H1 H2") as %?. Qed. 27 | 28 | Definition Ny := nroot.@"y". 29 | Definition Nx := nroot.@"x". 30 | 31 | Definition inv_x (γ : gname) (a : we) : iProp Σ := 32 | (∃ h, "x" ↦ᵤ h ∗ ⌜Maximum h = Some a⌝ ∗ ⌜WE_val a = #37⌝) ∨ token γ. 33 | 34 | Definition inv_y (γ : gname) : iProp Σ := 35 | ∃ h, "y" ↦ᵤ h ∗ ∀ a, (⌜a ∈ h ∧ WE_val a = (# 1)⌝) → 36 | (∃ a', ⌜a' <ₜ a⌝ ∗ inv Nx (inv_x γ a')). 37 | 38 | End Resources. 39 | -------------------------------------------------------------------------------- /aneris/examples/ccddb/instantiation/events.v: -------------------------------------------------------------------------------- 1 | From stdpp Require Import base gmap. 2 | From aneris.examples.ccddb.spec Require Import time events. 3 | From aneris.examples.ccddb.model Require Import events. 4 | From aneris.examples.ccddb.instantiation Require Import time. 5 | 6 | Instance we_timed : Timed write_event := we_time. 7 | Instance ae_timed : Timed apply_event := ae_time. 8 | 9 | Instance db_events : DB_events := 10 | { we := write_event; 11 | WE_val := we_val; 12 | WE_timed := we_timed; 13 | ae := apply_event; 14 | AE_val := ae_val; 15 | AE_key := ae_key; 16 | AE_timed := ae_timed; 17 | erasure := erase; 18 | erasure_time := erase_time; 19 | erasure_val:= erase_val; }. 20 | -------------------------------------------------------------------------------- /aneris/examples/ccddb/instantiation/time.v: -------------------------------------------------------------------------------- 1 | From aneris.examples.ccddb.spec Require Import time. 2 | From aneris.prelude Require Import time. 3 | 4 | Instance db_time : DB_time := 5 | {| Time := vector_clock; TM_le := vector_clock_le; TM_lt := vector_clock_lt; 6 | TM_lt_irreflexive := vector_clock_lt_irreflexive; 7 | TM_lt_TM_le := vector_clock_lt_le; 8 | TM_lt_exclusion := vector_clock_lt_exclusion; 9 | TM_le_eq_or_lt := vector_clock_le_eq_or_lt; 10 | TM_le_lt_trans := vector_clock_le_lt_trans; 11 | TM_lt_le_trans := vector_clock_lt_le_trans; |}. 12 | 13 | Instance maximals_computing : Maximals_Computing := 14 | {| Maximals := @compute_maximals; Maximum := @compute_maximum; 15 | Maximals_correct := @compute_maximals_correct; 16 | Maximum_correct := @compute_maximum_correct |}. 17 | -------------------------------------------------------------------------------- /aneris/examples/ccddb/resources/base.v: -------------------------------------------------------------------------------- 1 | From iris.algebra Require Import agree auth excl gmap. 2 | From aneris.aneris_lang Require Import resources. 3 | From aneris.aneris_lang.lib Require Import lock_proof. 4 | From aneris.algebra Require Import monotone. 5 | From iris.base_logic Require Import invariants. 6 | From aneris.prelude Require Export time. 7 | From aneris.examples.ccddb.model Require Import events. 8 | 9 | (** Modular specification for causal memory 10 | vector-clock based implementation. *) 11 | 12 | Definition seen_relation : relation (gset apply_event) := 13 | λ s s', s ⊆ s' ∧ 14 | ∀ ae ae', 15 | ae ∈ s' → ae' ∈ s' → 16 | vector_clock_lt (ae_time ae) (ae_time ae') → ae' ∈ s → ae ∈ s. 17 | 18 | Global Instance seen_relation_partial_order : PartialOrder seen_relation. 19 | Proof. 20 | split. 21 | - split. 22 | + rewrite /Reflexive /seen_relation. set_solver. 23 | + rewrite /Transitive /seen_relation. set_solver. 24 | - rewrite /AntiSymm /seen_relation. set_solver. 25 | Qed. 26 | 27 | Lemma seen_relation_union s1 s2 s : 28 | seen_relation s1 s → seen_relation s2 s → seen_relation (s1 ∪ s2) s. 29 | Proof. intros [Hs11 Hs12] [Hs21 Hs22]; split; set_solver. Qed. 30 | 31 | Class internal_DBG Σ := { 32 | IDBG_Global_mem_excl :> 33 | inG Σ (authUR (gmapUR Key (exclR (gsetO write_event)))); 34 | IDBG_Global_mem_mono :> inG Σ (authUR (gmapUR Key (gsetUR write_event))); 35 | IDBG_local_history_mono :> inG Σ (authUR (monotoneUR seen_relation)); 36 | IDBG_local_history_gset :> inG Σ (authUR (gsetUR apply_event)); 37 | IDBG_lockG :> lockG Σ; 38 | }. 39 | -------------------------------------------------------------------------------- /aneris/examples/ccddb/spec/base.v: -------------------------------------------------------------------------------- 1 | From RecordUpdate Require Import RecordSet. 2 | From aneris.aneris_lang Require Import network resources. 3 | From aneris.aneris_lang.lib.serialization Require Import serialization_proof. 4 | 5 | Definition Key := string. 6 | 7 | (** Arguments that user supplies to the interface *) 8 | 9 | Class DB_params := { 10 | DB_addresses : list socket_address; 11 | DB_addresses_NoDup : NoDup DB_addresses; 12 | DB_keys : gset Key; 13 | DB_InvName : namespace; 14 | DB_serialization : serialization; 15 | }. 16 | 17 | Notation DB_Serializable v := (Serializable DB_serialization v). 18 | 19 | Record SerializableVal `{!DB_params} := 20 | SerVal {SV_val : val; 21 | SV_ser : DB_Serializable SV_val }. 22 | 23 | Coercion SV_val : SerializableVal >-> val. 24 | 25 | Existing Instance SV_ser. 26 | 27 | Arguments SerVal {_} _ {_}. 28 | -------------------------------------------------------------------------------- /aneris/examples/ccddb/spec/events.v: -------------------------------------------------------------------------------- 1 | From stdpp Require Import gmap. 2 | From aneris.aneris_lang Require Import lang. 3 | From aneris.examples.ccddb.spec Require Import base time. 4 | 5 | (** Write and apply events *) 6 | 7 | Section Events. 8 | Context `{!DB_time}. 9 | 10 | Class DB_events := 11 | { 12 | (** Write events *) 13 | 14 | we : Type; 15 | WE_val : we → val; 16 | WE_timed :> Timed we; 17 | WE_EqDecision :> EqDecision we; 18 | WE_Countable :> Countable we; 19 | 20 | (** Apply events *) 21 | 22 | ae : Type; 23 | AE_key : ae → Key; 24 | AE_val : ae → val; 25 | AE_timed :> Timed ae; 26 | AE_EqDecision :> EqDecision ae; 27 | AE_Countable :> Countable ae; 28 | 29 | (** Erasure events *) 30 | 31 | erasure : ae → we; 32 | erasure_val: ∀ (e : ae), (erasure e).(WE_val) = e.(AE_val); 33 | erasure_time: ∀ (e : ae), (erasure e) =ₜ e; 34 | }. 35 | 36 | (** Aliases for sets of events *) 37 | 38 | Context `{!DB_events}. 39 | 40 | Notation gmem := (gset we). 41 | Notation lhst := (gset ae). 42 | Definition restrict_key (k : Key) (s : lhst) 43 | : gset ae := filter (λ x, AE_key x = k) s. 44 | 45 | Definition seen_relation : relation lhst := 46 | λ s s', s ⊆ s' ∧ 47 | ∀ ae ae', 48 | ae ∈ s' → ae' ∈ s' → ae <ₜ ae' → ae' ∈ s → ae ∈ s. 49 | 50 | End Events. 51 | 52 | Notation gmem := (gset we). 53 | Notation lhst := (gset ae). 54 | -------------------------------------------------------------------------------- /aneris/examples/ccddb/spec/spec.v: -------------------------------------------------------------------------------- 1 | (** Modular specification for the causally consistent distributed database. *) 2 | From aneris.examples.ccddb.spec Require Export base time events resources init. 3 | -------------------------------------------------------------------------------- /aneris/examples/crdt/oplib/examples/add_wins_set/add_wins_set_code.v: -------------------------------------------------------------------------------- 1 | (* This file is automatically generated from the OCaml source file 2 | /ml_sources/examples/crdt/oplib/examples/add_wins_set/add_wins_set_code.ml *) 3 | 4 | From aneris.aneris_lang Require Import ast. 5 | From aneris.aneris_lang.lib Require Import list_code. 6 | From aneris.aneris_lang.lib.vector_clock Require Import vector_clock_code. 7 | From aneris.aneris_lang.lib.serialization Require Import serialization_code. 8 | From aneris.examples.crdt.oplib Require Import oplib_code. 9 | 10 | Definition init_st : val := λ: <>, []. 11 | 12 | Definition effect : val := 13 | λ: "msg" "st", 14 | let: "v" := Fst (Fst "msg") in 15 | let: "vc" := Snd (Fst "msg") in 16 | let: "_u" := Snd "msg" in 17 | match: "v" with 18 | InjL "w" => ("w", "vc") :: "st" 19 | | InjR "w" => 20 | let: "should_keep" := λ: "p", 21 | (if: (Fst "p") = "w" 22 | then let: "vc'" := Snd "p" in 23 | ~ (vect_leq "vc'" "vc") 24 | else #true) in 25 | list_filter "should_keep" "st" 26 | end. 27 | 28 | Definition aws_crdt : val := λ: <>, (init_st, effect). 29 | 30 | Definition aws_init val_ser val_deser : val := 31 | λ: "addrs" "rid", 32 | let: "initRes" := oplib_init (sum_ser val_ser val_ser) 33 | (sum_deser val_deser val_deser) "addrs" "rid" aws_crdt in 34 | let: "get_state" := Fst "initRes" in 35 | let: "update" := Snd "initRes" in 36 | ("get_state", "update"). 37 | -------------------------------------------------------------------------------- /aneris/examples/crdt/oplib/examples/gcounter/gcounter_code.v: -------------------------------------------------------------------------------- 1 | (* This file is automatically generated from the OCaml source file 2 | /ml_sources/examples/crdt/oplib/examples/gcounter/gcounter_code.ml *) 3 | 4 | From aneris.aneris_lang Require Import ast. 5 | From aneris.aneris_lang.lib.serialization Require Import serialization_code. 6 | From aneris.aneris_lang.lib Require Import list_code. 7 | From aneris.examples.crdt.oplib Require Import oplib_code. 8 | 9 | Definition effect : val := 10 | λ: "msg" "counter", 11 | let: "delta" := Fst (Fst "msg") in 12 | let: "_x" := Snd (Fst "msg") in 13 | let: "_y" := Snd "msg" in 14 | assert: (#0 ≤ "delta");; 15 | "counter" + "delta". 16 | 17 | Definition init_st : val := λ: <>, #0. 18 | 19 | Definition counter_crdt : val := λ: <>, (init_st, effect). 20 | 21 | Definition counter_init : val := 22 | λ: "addrs" "rid", 23 | let: "initRes" := oplib_init int_ser int_deser "addrs" "rid" counter_crdt in 24 | let: "get_state" := Fst "initRes" in 25 | let: "update" := Snd "initRes" in 26 | ("get_state", "update"). 27 | -------------------------------------------------------------------------------- /aneris/examples/crdt/oplib/examples/grow_only_set/grow_only_set_code.v: -------------------------------------------------------------------------------- 1 | (* This file is automatically generated from the OCaml source file 2 | /ml_sources/examples/crdt/oplib/examples/grow_only_set/grow_only_set_code.ml *) 3 | 4 | From aneris.aneris_lang Require Import ast. 5 | From aneris.aneris_lang.lib Require Import set_code. 6 | From aneris.examples.crdt.oplib Require Import oplib_code. 7 | 8 | Definition init_st : val := λ: <>, set_empty #(). 9 | 10 | Definition effect : val := 11 | λ: "msg" "st", 12 | let: "v" := Fst (Fst "msg") in 13 | let: "_vc" := Snd (Fst "msg") in 14 | let: "_u" := Snd "msg" in 15 | set_add "v" "st". 16 | 17 | Definition gos_crdt : val := λ: <>, (init_st, effect). 18 | 19 | Definition gos_init val_ser val_deser : val := 20 | λ: "addrs" "rid", 21 | let: "initRes" := oplib_init val_ser val_deser "addrs" "rid" gos_crdt in 22 | let: "get_state" := Fst "initRes" in 23 | let: "update" := Snd "initRes" in 24 | ("get_state", "update"). 25 | -------------------------------------------------------------------------------- /aneris/examples/crdt/oplib/examples/map_comb/map_comb_code.v: -------------------------------------------------------------------------------- 1 | (* This file is automatically generated from the OCaml source file 2 | /ml_sources/examples/crdt/oplib/examples/map_comb/map_comb_code.ml *) 3 | 4 | From aneris.aneris_lang Require Import ast. 5 | From aneris.aneris_lang.lib.serialization Require Import serialization_code. 6 | From aneris.aneris_lang.lib Require Import map_code. 7 | From aneris.aneris_lang.lib Require Import list_code. 8 | From aneris.examples.crdt.oplib Require Import oplib_code. 9 | 10 | Definition map_comb_effect : val := 11 | λ: "init" "eff" "msg" "state", 12 | let: "key" := Fst (Fst (Fst "msg")) in 13 | let: "delta" := Snd (Fst (Fst "msg")) in 14 | let: "vc" := Snd (Fst "msg") in 15 | let: "origin" := Snd "msg" in 16 | let: "cur_st_wo" := match: map_lookup "key" "state" with 17 | NONE => ("init" #(), "state") 18 | | SOME "cur" => ("cur", map_remove "key" "state") 19 | end in 20 | let: "current" := Fst "cur_st_wo" in 21 | let: "state_without" := Snd "cur_st_wo" in 22 | let: "newval" := "eff" ("delta", "vc", "origin") "current" in 23 | map_insert "key" "newval" "state_without". 24 | 25 | Definition map_comb_init_st : val := λ: <>, map_empty #(). 26 | 27 | Definition map_comb_crdt : val := 28 | λ: "crdt" <>, 29 | let: "res" := "crdt" #() in 30 | let: "is" := Fst "res" in 31 | let: "eff" := Snd "res" in 32 | (map_comb_init_st, map_comb_effect "is" "eff"). 33 | 34 | Definition map_comb_init (ser : val) (deser : val) : val := 35 | λ: "crdt" "addrs" "rid", 36 | let: "initRes" := oplib_init (prod_ser string_ser ser) 37 | (prod_deser string_ser deser) "addrs" "rid" 38 | (map_comb_crdt "crdt") in 39 | let: "get_state" := Fst "initRes" in 40 | let: "update" := Snd "initRes" in 41 | ("get_state", "update"). 42 | -------------------------------------------------------------------------------- /aneris/examples/crdt/oplib/examples/mvreg/mvreg_code.v: -------------------------------------------------------------------------------- 1 | (* This file is automatically generated from the OCaml source file 2 | /ml_sources/examples/crdt/oplib/examples/mvreg/mvreg_code.ml *) 3 | 4 | From aneris.aneris_lang Require Import ast. 5 | From aneris.aneris_lang.lib.serialization Require Import serialization_code. 6 | From aneris.aneris_lang.lib Require Import list_code. 7 | From aneris.aneris_lang.lib.vector_clock Require Import vector_clock_code. 8 | From aneris.examples.crdt.oplib Require Import oplib_code. 9 | 10 | Definition init_st : val := λ: <>, []. 11 | 12 | Definition effect : val := 13 | λ: "msg" "reg", 14 | let: "v" := Fst (Fst "msg") in 15 | let: "vc" := Snd (Fst "msg") in 16 | let: "_u" := Snd "msg" in 17 | let: "vals" := let: "is_conc" := λ: "p", 18 | let: "vc'" := Snd "p" in 19 | assert: (~ (vect_leq "vc" "vc'"));; 20 | vect_conc "vc'" "vc" in 21 | list_filter "is_conc" "reg" in 22 | ("v", "vc") :: "vals". 23 | 24 | Definition mvreg_crdt : val := λ: <>, (init_st, effect). 25 | 26 | Definition mvreg_init : val := 27 | λ: "addrs" "rid", 28 | let: "initRes" := oplib_init int_ser int_deser "addrs" "rid" mvreg_crdt in 29 | let: "get_state" := Fst "initRes" in 30 | let: "update" := Snd "initRes" in 31 | ("get_state", "update"). 32 | -------------------------------------------------------------------------------- /aneris/examples/crdt/oplib/examples/pncounter/pncounter_code.v: -------------------------------------------------------------------------------- 1 | (* This file is automatically generated from the OCaml source file 2 | /ml_sources/examples/crdt/oplib/examples/pncounter/pncounter_code.ml *) 3 | 4 | From aneris.aneris_lang Require Import ast. 5 | From aneris.aneris_lang.lib.serialization Require Import serialization_code. 6 | From aneris.aneris_lang.lib Require Import list_code. 7 | From aneris.examples.crdt.oplib Require Import oplib_code. 8 | 9 | Definition pncounter_effect : val := 10 | λ: "msg" "counter", 11 | let: "delta" := Fst (Fst "msg") in 12 | let: "_x" := Snd (Fst "msg") in 13 | let: "_y" := Snd "msg" in 14 | "counter" + "delta". 15 | 16 | Definition pncounter_init_st : val := λ: <>, #0. 17 | 18 | Definition pncounter_crdt : val := 19 | λ: <>, (pncounter_init_st, pncounter_effect). 20 | 21 | Definition pncounter_init : val := 22 | λ: "addrs" "rid", 23 | let: "initRes" := oplib_init int_ser int_deser "addrs" "rid" pncounter_crdt in 24 | let: "get_state" := Fst "initRes" in 25 | let: "update" := Snd "initRes" in 26 | ("get_state", "update"). 27 | -------------------------------------------------------------------------------- /aneris/examples/crdt/oplib/examples/prod_comb/prod_comb_code.v: -------------------------------------------------------------------------------- 1 | (* This file is automatically generated from the OCaml source file 2 | /ml_sources/examples/crdt/oplib/examples/prod_comb/prod_comb_code.ml *) 3 | 4 | From aneris.aneris_lang Require Import ast. 5 | From aneris.aneris_lang.lib.serialization Require Import serialization_code. 6 | From aneris.aneris_lang.lib Require Import list_code. 7 | From aneris.examples.crdt.oplib Require Import oplib_code. 8 | 9 | Definition effect : val := 10 | λ: "eff1" "eff2" "msg" "state", 11 | let: "delta1" := Fst (Fst (Fst "msg")) in 12 | let: "delta2" := Snd (Fst (Fst "msg")) in 13 | let: "vc" := Snd (Fst "msg") in 14 | let: "origin" := Snd "msg" in 15 | let: "st1" := Fst "state" in 16 | let: "st2" := Snd "state" in 17 | ("eff1" ("delta1", "vc", "origin") "st1", "eff2" ("delta2", "vc", "origin") 18 | "st2"). 19 | 20 | Definition init_st : val := λ: "is1" "is2" <>, ("is1" #(), "is2" #()). 21 | 22 | Definition prod_comb_crdt : val := 23 | λ: "crdt1" "crdt2" <>, 24 | let: "res1" := "crdt1" #() in 25 | let: "res2" := "crdt2" #() in 26 | let: "is1" := Fst "res1" in 27 | let: "eff1" := Snd "res1" in 28 | let: "is2" := Fst "res2" in 29 | let: "eff2" := Snd "res2" in 30 | (init_st "is1" "is2", effect "eff1" "eff2"). 31 | 32 | Definition prod_comb_init (a_ser : val) (a_deser : val) (b_ser : val) 33 | (b_deser : val) : val := 34 | λ: "crdt1" "crdt2" "addrs" "rid", 35 | let: "initRes" := oplib_init (prod_ser a_ser b_ser) 36 | (prod_deser a_deser b_deser) "addrs" "rid" 37 | (prod_comb_crdt "crdt1" "crdt2") in 38 | let: "get_state" := Fst "initRes" in 39 | let: "update" := Snd "initRes" in 40 | ("get_state", "update"). 41 | -------------------------------------------------------------------------------- /aneris/examples/crdt/oplib/examples/table_of_counters/table_of_counters_code.v: -------------------------------------------------------------------------------- 1 | (* This file is automatically generated from the OCaml source file 2 | /ml_sources/examples/crdt/oplib/examples/table_of_counters/table_of_counters_code.ml *) 3 | 4 | From aneris.aneris_lang Require Import ast. 5 | From aneris.aneris_lang.lib.serialization Require Import serialization_code. 6 | From aneris.aneris_lang.lib Require Import list_code. 7 | From aneris.examples.crdt.oplib Require Import oplib_code. 8 | From aneris.examples.crdt.oplib.examples.map_comb Require Import map_comb_code. 9 | From aneris.examples.crdt.oplib.examples.pncounter Require Import pncounter_code. 10 | 11 | Definition table_of_counters_effect : val := 12 | λ: "msg" "st", 13 | map_comb_effect pncounter_init_st pncounter_effect "msg" "st". 14 | 15 | Definition table_of_counters_init_st : val := λ: <>, map_comb_init_st #(). 16 | 17 | Definition table_of_counters_crdt : val := 18 | λ: <>, (table_of_counters_init_st, table_of_counters_effect). 19 | 20 | Definition table_of_counters_init : val := 21 | λ: "addrs" "rid", 22 | let: "initRes" := oplib_init (prod_ser string_ser int_ser) 23 | (prod_deser string_deser int_deser) "addrs" "rid" 24 | table_of_counters_crdt in 25 | let: "get_state" := Fst "initRes" in 26 | let: "update" := Snd "initRes" in 27 | ("get_state", "update"). 28 | -------------------------------------------------------------------------------- /aneris/examples/crdt/oplib/examples/table_of_lwwregs/table_of_lwwregs_code.v: -------------------------------------------------------------------------------- 1 | (* This file is automatically generated from the OCaml source file 2 | /ml_sources/examples/crdt/oplib/examples/table_of_lwwregs/table_of_lwwregs_code.ml *) 3 | 4 | From aneris.aneris_lang Require Import ast. 5 | From aneris.aneris_lang.lib.serialization Require Import serialization_code. 6 | From aneris.aneris_lang.lib Require Import list_code. 7 | From aneris.examples.crdt.oplib Require Import oplib_code. 8 | From aneris.examples.crdt.oplib.examples.map_comb Require Import map_comb_code. 9 | From aneris.examples.crdt.oplib.examples.lwwreg Require Import lwwreg_code. 10 | 11 | Definition table_of_lwwregs_effect : val := 12 | λ: "msg" "st", map_comb_effect lwwreg_init_st lwwreg_effect "msg" "st". 13 | 14 | Definition table_of_lwwregs_init_st : val := λ: <>, map_comb_init_st #(). 15 | 16 | Definition table_of_lwwregs_crdt : val := 17 | λ: <>, (table_of_lwwregs_init_st, table_of_lwwregs_effect). 18 | 19 | Definition table_of_lwwregs_init val_ser val_deser : val := 20 | λ: "addrs" "rid", 21 | let: "initRes" := oplib_init (prod_ser string_ser val_ser) 22 | (prod_deser string_deser val_deser) "addrs" "rid" 23 | table_of_lwwregs_crdt in 24 | let: "get_state" := Fst "initRes" in 25 | let: "update" := Snd "initRes" in 26 | ("get_state", "update"). 27 | -------------------------------------------------------------------------------- /aneris/examples/crdt/oplib/examples/two_p_set/two_p_set_code.v: -------------------------------------------------------------------------------- 1 | (* This file is automatically generated from the OCaml source file 2 | /ml_sources/examples/crdt/oplib/examples/two_p_set/two_p_set_code.ml *) 3 | 4 | From aneris.aneris_lang Require Import ast. 5 | From aneris.aneris_lang.lib Require Import set_code. 6 | From aneris.aneris_lang.lib.serialization Require Import serialization_code. 7 | From aneris.examples.crdt.oplib Require Import oplib_code. 8 | 9 | Definition init_st : val := λ: <>, (set_empty #(), set_empty #()). 10 | 11 | Definition effect : val := 12 | λ: "msg" "st", 13 | let: "v" := Fst (Fst "msg") in 14 | let: "_vc" := Snd (Fst "msg") in 15 | let: "_u" := Snd "msg" in 16 | match: "v" with 17 | InjL "w" => (set_add "w" (Fst "st"), Snd "st") 18 | | InjR "w" => (Fst "st", set_add "w" (Snd "st")) 19 | end. 20 | 21 | Definition tps_crdt : val := λ: <>, (init_st, effect). 22 | 23 | Definition tps_init val_ser val_deser : val := 24 | λ: "addrs" "rid", 25 | let: "initRes" := oplib_init (sum_ser val_ser val_ser) 26 | (sum_deser val_deser val_deser) "addrs" "rid" tps_crdt in 27 | let: "get_state" := Fst "initRes" in 28 | let: "update" := Snd "initRes" in 29 | ("get_state", "update"). 30 | -------------------------------------------------------------------------------- /aneris/examples/crdt/oplib/oplib_code.v: -------------------------------------------------------------------------------- 1 | (* This file is automatically generated from the OCaml source file 2 | /ml_sources/examples/crdt/oplib/oplib_code.ml *) 3 | 4 | From aneris.aneris_lang Require Import ast. 5 | From aneris.aneris_lang.lib Require Import list_code. 6 | From aneris.aneris_lang.lib.vector_clock Require Import vector_clock_code. 7 | From aneris.examples.rcb Require Import rcb_code. 8 | 9 | Definition get_state : val := 10 | λ: "lock" "st" <>, 11 | acquire "lock";; 12 | let: "res" := ! "st" in 13 | release "lock";; 14 | "res". 15 | 16 | Definition apply_thread : val := 17 | λ: "lock" "deliver" "st" "effect", 18 | loop_forever (λ: <>, 19 | acquire "lock";; 20 | match: "deliver" #() with 21 | SOME "msg" => "st" <- ("effect" "msg" ! "st") 22 | | NONE => #() 23 | end;; 24 | release "lock"). 25 | 26 | Definition update : val := 27 | λ: "lock" "broadcast" "st" "effect" "op", 28 | acquire "lock";; 29 | let: "msg" := "broadcast" "op" in 30 | "st" <- ("effect" "msg" ! "st");; 31 | release "lock". 32 | 33 | Definition oplib_init op_ser op_deser : val := 34 | λ: "addrs" "rid" "crdt", 35 | let: "rcbInitRes" := rcb_init op_ser op_deser "addrs" "rid" in 36 | let: "deliver" := Fst "rcbInitRes" in 37 | let: "broadcast" := Snd "rcbInitRes" in 38 | let: "crdt_res" := "crdt" #() in 39 | let: "init_st" := Fst "crdt_res" in 40 | let: "effect" := Snd "crdt_res" in 41 | let: "st" := ref ("init_st" #()) in 42 | let: "lock" := newlock #() in 43 | Fork (apply_thread "lock" "deliver" "st" "effect");; 44 | (get_state "lock" "st", update "lock" "broadcast" "st" "effect"). 45 | -------------------------------------------------------------------------------- /aneris/examples/crdt/oplib/proof/time.v: -------------------------------------------------------------------------------- 1 | From aneris.examples.crdt.spec Require Import crdt_time. 2 | From aneris.prelude Require Import time. 3 | 4 | Section Time. 5 | 6 | Global Instance vc_time : Log_Time := 7 | {| Time := vector_clock; 8 | TM_le := vector_clock_le; 9 | TM_lt := vector_clock_lt; 10 | TM_lt_irreflexive := vector_clock_lt_irreflexive; 11 | TM_lt_TM_le := vector_clock_lt_le; 12 | TM_le_eq_or_lt := vector_clock_le_eq_or_lt; 13 | TM_le_lt_trans := vector_clock_le_lt_trans; 14 | TM_lt_le_trans := vector_clock_lt_le_trans; |}. 15 | 16 | End Time. 17 | -------------------------------------------------------------------------------- /aneris/examples/crdt/spec/crdt_base.v: -------------------------------------------------------------------------------- 1 | From RecordUpdate Require Import RecordSet. 2 | From aneris.aneris_lang Require Import network resources. 3 | 4 | (** * Generic CRDT interface parameters *) 5 | 6 | Class CRDT_Params := { 7 | CRDT_Addresses : list socket_address; 8 | CRDT_Addresses_NoDup : NoDup CRDT_Addresses; 9 | CRDT_InvName : namespace; 10 | }. 11 | -------------------------------------------------------------------------------- /aneris/examples/crdt/spec/crdt_denot.v: -------------------------------------------------------------------------------- 1 | From Coq Require Import ssreflect. 2 | From stdpp Require Import base gmap. 3 | From aneris.examples.crdt.spec Require Import crdt_time crdt_events. 4 | 5 | (** * Denotations for CRDTs *) 6 | 7 | Section Denotations. 8 | 9 | (* `Op` is the type of operations embedded in events. 10 | `St` is the type of (logical) states of the CRDT. 11 | Events have type `Event` which comes from `Log_Events` below. *) 12 | Context {Op St : Type}. 13 | Context `{!Log_Time, !EqDecision Op, !Countable Op}. 14 | 15 | Definition Rel2 (A B : Type) := A -> B -> Prop. 16 | 17 | (* A functional relation *) 18 | Class Rel2__Fun {A B : Type} (R : Rel2 A B) := { 19 | rel2_fun : ∀ {a : A} {b b' : B}, R a b -> R a b' -> b = b' 20 | }. 21 | 22 | (* A CRDT denotation is just a way to give meanings to sets of events. 23 | The denotation can then serve as a (declarative, high level) specification 24 | of a CRDT. *) 25 | Class CrdtDenot := { 26 | (* A denotation is a relation that relates a set of events to at most one logical 27 | state. We say at most one because a particular set of events could fail to be 28 | related to _any_ states at all (because the set of events is invalid). *) 29 | crdt_denot : Rel2 (gset (Event Op)) St; 30 | 31 | crdt_denot_fun :> Rel2__Fun crdt_denot 32 | }. 33 | 34 | End Denotations. 35 | 36 | Arguments CrdtDenot (Op St) {_ _ _}. 37 | 38 | Notation "'⟦' s '⟧' '⇝' st" := (crdt_denot s st) (at level 80, no associativity). 39 | -------------------------------------------------------------------------------- /aneris/examples/crdt/spec/crdt_spec.v: -------------------------------------------------------------------------------- 1 | From aneris.examples.crdt.spec Require Export crdt_base crdt_events crdt_time crdt_denot crdt_resources. 2 | -------------------------------------------------------------------------------- /aneris/examples/crdt/statelib/proof/time.v: -------------------------------------------------------------------------------- 1 | From stdpp Require Import gmap. 2 | From aneris.examples.crdt.spec Require Import crdt_time. 3 | 4 | Section Time. 5 | 6 | Definition RepId := nat. 7 | Definition SeqNum := nat. 8 | Definition EvId : Type := RepId * SeqNum. 9 | Definition Timestamp := gset EvId. 10 | 11 | Definition ts_le (ts1 ts2 : Timestamp) : Prop := ts1 ⊆ ts2. 12 | 13 | Definition ts_lt (ts1 ts2 : Timestamp) : Prop := ts1 ⊂ ts2. 14 | 15 | Global Instance timestamp_time : Log_Time. 16 | Admitted. 17 | (* TODO 18 | Global Instance timestamp_time : Log_Time := 19 | {| Time := vector_clock; 20 | TM_le := vector_clock_le; 21 | TM_lt := vector_clock_lt; 22 | TM_lt_irreflexive := vector_clock_lt_irreflexive; 23 | TM_lt_TM_le := vector_clock_lt_le; 24 | TM_le_eq_or_lt := vector_clock_le_eq_or_lt; 25 | TM_le_lt_trans := vector_clock_le_lt_trans; 26 | TM_lt_le_trans := vector_clock_lt_le_trans; |}. 27 | *) 28 | 29 | End Time. 30 | -------------------------------------------------------------------------------- /aneris/examples/dscm/clients/example1_code.v: -------------------------------------------------------------------------------- 1 | From aneris.aneris_lang Require Import ast. 2 | From aneris.aneris_lang.lib Require Import par_code. 3 | 4 | Definition par_prog : expr := 5 | λ: "wr" "rd", 6 | "wr" #"x" #0;; 7 | "wr" #"y" #0;; 8 | ("wr" #"x" #1;; "rd" #"y") ||| ("wr" #"y" #1;; "rd" #"x" ). 9 | 10 | Definition init_prog (init : val) (sa : socket_address) : expr := 11 | λ: "dbs", 12 | let: "p" := init "dbs" #sa in 13 | let: "rd" := Fst "p" in 14 | let: "wr" := Snd "p" in 15 | par_prog "wr" "rd". 16 | -------------------------------------------------------------------------------- /aneris/examples/dscm/clients/example2_code.v: -------------------------------------------------------------------------------- 1 | From aneris.aneris_lang Require Import ast. 2 | From aneris.aneris_lang.lib Require Import par_code. 3 | From aneris.examples.dscm Require Import base. 4 | 5 | Definition thread (init : val) (sa : socket_address) (k : Key) (n : Z) : val := 6 | λ: "dbs", 7 | let: "p" := init #sa "dbs" in 8 | let: "rd" := Fst "p" in 9 | let: "wr" := Snd "p" in 10 | "wr" #k #n;; "rd" #k. 11 | 12 | Definition prog (init : val) (sa1 sa2 : socket_address) (k : Key) (n1 n2 : Z) : val := 13 | λ: "dbs", 14 | ( thread init sa1 k n1 "dbs" ||| thread init sa2 k n2 "dbs" ). 15 | -------------------------------------------------------------------------------- /aneris/examples/dscm/implementations/one_server/one_server_client_proxy_code.v: -------------------------------------------------------------------------------- 1 | (* This file is automatically generated from the OCaml source file 2 | /ml_sources/examples/dscm/implementations/one_server/one_server_client_proxy_code.ml *) 3 | 4 | From aneris.aneris_lang Require Import ast. 5 | From aneris.examples.dscm.implementations.one_server Require Import one_server_serialization_code. 6 | 7 | Definition wait_for_reply val_ser : val := 8 | λ: "srv" "sh" "reqId" "reqMsg", 9 | let: "rid" := ! "reqId" in 10 | letrec: "aux" <> := 11 | match: ReceiveFrom "sh" with 12 | NONE => SendTo "sh" "reqMsg" "srv";; 13 | #();; 14 | "aux" #() 15 | | SOME "rply" => 16 | let: "repl" := (reply_serializer val_ser).(s_deser) (Fst "rply") in 17 | let: "res" := Fst "repl" in 18 | let: "resId" := Snd "repl" in 19 | assert: ("resId" ≤ "rid");; 20 | (if: "resId" = "rid" 21 | then "reqId" <- ("rid" + #1);; 22 | "res" 23 | else "aux" #()) 24 | end in 25 | "aux" #(). 26 | 27 | Definition request val_ser : val := 28 | λ: "srv" "sh" "lock" "reqId" "req", 29 | acquire "lock";; 30 | let: "reqMsg" := (request_serializer val_ser).(s_ser) ("req", ! "reqId") in 31 | SendTo "sh" "reqMsg" "srv";; 32 | #();; 33 | let: "r" := wait_for_reply val_ser "srv" "sh" "reqId" "reqMsg" in 34 | release "lock";; 35 | "r". 36 | 37 | Definition install_proxy val_ser : val := 38 | λ: "srv" "caddr", 39 | let: "sh" := NewSocket #() in 40 | let: "reqId" := ref #0 in 41 | SocketBind "sh" "caddr";; 42 | SetReceiveTimeout "sh" #3 #0;; 43 | let: "lock" := newlock #() in 44 | let: "wr" := λ: "k" "v", 45 | request val_ser "srv" "sh" "lock" "reqId" (InjL ("k", "v")) in 46 | let: "rd" := λ: "k", 47 | request val_ser "srv" "sh" "lock" "reqId" (InjR "k") in 48 | ("wr", "rd"). 49 | -------------------------------------------------------------------------------- /aneris/examples/dscm/implementations/one_server/one_server_serialization_code.v: -------------------------------------------------------------------------------- 1 | (* This file is automatically generated from the OCaml source file 2 | /ml_sources/examples/dscm/implementations/one_server/one_server_serialization_code.ml *) 3 | 4 | From aneris.aneris_lang Require Import ast. 5 | From aneris.aneris_lang.lib.serialization Require Import serialization_code. 6 | 7 | (** Serialization *) 8 | 9 | Definition seqId_serializer := int_serializer. 10 | 11 | Definition write_serializer val_ser := 12 | prod_serializer string_serializer val_ser. 13 | 14 | Definition read_serializer := string_serializer. 15 | 16 | Definition request_serializer val_ser := 17 | prod_serializer (sum_serializer (write_serializer val_ser) read_serializer) 18 | seqId_serializer. 19 | 20 | Definition reply_serializer val_ser := 21 | prod_serializer (sum_serializer unit_serializer (option_serializer val_ser)) 22 | seqId_serializer. 23 | -------------------------------------------------------------------------------- /aneris/examples/dscm/spec/base.v: -------------------------------------------------------------------------------- 1 | From RecordUpdate Require Import RecordSet. 2 | From aneris.aneris_lang Require Import network resources. 3 | From aneris.aneris_lang.lib.serialization Require Import serialization_proof. 4 | 5 | Definition Key := string. 6 | 7 | (** Arguments that user supplies to the interface *) 8 | 9 | Class DB_params := { 10 | DB_addresses : list socket_address; (* can we remove it ? *) 11 | DB_addresses_NoDup : NoDup DB_addresses; 12 | DB_keys : gset Key; 13 | DB_InvName : namespace; (* Global Invariant *) 14 | DB_serialization : serialization; 15 | }. 16 | 17 | Notation DB_Serializable v := (Serializable DB_serialization v). 18 | 19 | Record SerializableVal `{!DB_params} := 20 | SerVal {SV_val : val; 21 | SV_ser : DB_Serializable SV_val }. 22 | 23 | Coercion SV_val : SerializableVal >-> val. 24 | 25 | Existing Instance SV_ser. 26 | 27 | Arguments SerVal {_} _ {_}. 28 | -------------------------------------------------------------------------------- /aneris/examples/dscm/spec/spec.v: -------------------------------------------------------------------------------- 1 | (** Modular specification for the causally consistent distributed database. *) 2 | From aneris.examples.ccddb.spec Require Export base time events resources init. 3 | -------------------------------------------------------------------------------- /aneris/examples/echo/echo_code.v: -------------------------------------------------------------------------------- 1 | From aneris.aneris_lang Require Import lang. 2 | From aneris.aneris_lang.lib Require Export network_util_code list_code. 3 | 4 | Definition echo_server : val := 5 | λ: "addr", 6 | let: "socket" := NewSocket #() in 7 | SocketBind "socket" "addr";; 8 | (rec: "go" <> := 9 | let: "m" := unSOME $ ReceiveFrom "socket" in 10 | let: "m1" := Fst "m" in 11 | let: "m2" := Snd "m" in 12 | SendTo "socket" "m1" "m2";; 13 | "go" #()) #(). 14 | 15 | Definition echo_client : val := λ: "c_addr" "s_addr", 16 | let: "socket" := NewSocket #() in 17 | SocketBind "socket" "c_addr";; 18 | SendTo "socket" #"Hello" "s_addr";; 19 | let: "m1" := unSOME (ReceiveFrom "socket") in 20 | SendTo "socket" #"World" "s_addr";; 21 | let: "m2" := wait_receivefresh "socket" ["m1"] in 22 | let: "m1'" := Fst "m1" in 23 | let: "m2'" := Fst "m2" in 24 | assert: ("m1'" = #"Hello");; 25 | assert: ("m2'" = #"World"). 26 | 27 | Definition echo_runner : expr := 28 | let: "s_addr" := MakeAddress #"0.0.0.0" #80 in 29 | let: "c_addr" := MakeAddress #"0.0.0.1" #80 in 30 | Start "0.0.0.0" (echo_server "s_addr");; 31 | Start "0.0.0.1" (echo_client "c_addr" "s_addr"). 32 | -------------------------------------------------------------------------------- /aneris/examples/echo_groups/code.v: -------------------------------------------------------------------------------- 1 | From aneris.aneris_lang Require Import lang. 2 | From aneris.aneris_lang.lib Require Export network_util_code. 3 | 4 | Definition server1 : val := 5 | λ: "addr", 6 | let: "socket" := NewSocket #() in 7 | SocketBind "socket" "addr";; 8 | "socket". 9 | 10 | Definition server2 : val := 11 | λ: "socket", 12 | let: "m" := unSOME (ReceiveFrom "socket") in "m". 13 | 14 | Definition server3 : val := 15 | λ: "socket" "m", 16 | let: "msg" := Fst "m" in 17 | let: "sender" := Snd "m" in 18 | SendTo "socket" #"done" "sender". 19 | 20 | Definition server : val := 21 | λ: "addr", 22 | let: "socket" := server1 "addr" in 23 | let: "m" := server2 "socket" in 24 | server3 "socket" "m". 25 | 26 | Definition client : val := λ: "c_addr" "s_addr_1" "s_addr_2", 27 | let: "socket" := NewSocket #() in 28 | SocketBind "socket" "c_addr";; 29 | SendTo "socket" #"do" "s_addr_1";; 30 | SendTo "socket" #"do" "s_addr_2";; 31 | Fst (unSOME (ReceiveFrom "socket")). 32 | 33 | Definition echo_runner : expr := 34 | let: "c_addr" := MakeAddress #"0.0.0.0" #80 in 35 | let: "s_addr1" := MakeAddress #"0.0.0.1" #80 in 36 | let: "s_addr2" := MakeAddress #"0.0.0.2" #80 in 37 | Start "0.0.0.0" (client "c_addr" "s_addr1" "s_addr2") ;; 38 | Start "0.0.0.1" (server "s_addr1");; 39 | Start "0.0.0.2" (server "s_addr2"). 40 | -------------------------------------------------------------------------------- /aneris/examples/minimal_example/minimal_example_code.v: -------------------------------------------------------------------------------- 1 | From aneris.aneris_lang Require Import ast. 2 | 3 | Definition incr_loop : val := 4 | rec: "incr_loop" "l" := 5 | let: "n" := !"l" in 6 | CAS "l" "n" ("n" + #1);; 7 | "incr_loop" "l". 8 | 9 | Definition incr_example : expr := 10 | let: "l" := ref<<"s">> #0 in 11 | Fork (incr_loop "l");; incr_loop "l". 12 | -------------------------------------------------------------------------------- /aneris/examples/ping_pong_done/ping_pong_done_code.v: -------------------------------------------------------------------------------- 1 | (* This file is automatically generated from the OCaml source file 2 | /ml_sources/examples/ping_pong_done/ping_pong_done_code.ml *) 3 | 4 | From aneris.aneris_lang Require Import ast. 5 | From aneris.aneris_lang.lib Require Import network_util_code. 6 | 7 | Definition pong : val := 8 | λ: "addr", 9 | let: "skt" := NewSocket #() in 10 | SocketBind "skt" "addr";; 11 | let: "msg" := unSOME (ReceiveFrom "skt") in 12 | let: "sender" := Snd "msg" in 13 | assert: ((Fst "msg") = #"PING");; 14 | SendTo "skt" #"PONG" "sender";; 15 | #();; 16 | letrec: "loop" <> := 17 | let: "ack" := unSOME (ReceiveFrom "skt") in 18 | let: "body" := Fst "ack" in 19 | (if: "body" = #"PING" 20 | then "loop" #() 21 | else "body") in 22 | "loop" #(). 23 | 24 | Definition ping : val := 25 | λ: "addr" "server", 26 | let: "skt" := NewSocket #() in 27 | SocketBind "skt" "addr";; 28 | SendTo "skt" #"PING" "server";; 29 | #();; 30 | let: "msg" := unSOME (ReceiveFrom "skt") in 31 | assert: ((Fst "msg") = #"PONG");; 32 | SendTo "skt" #"DONE" "server";; 33 | #(). 34 | -------------------------------------------------------------------------------- /aneris/examples/ping_pong_done/ping_pong_done_runner.v: -------------------------------------------------------------------------------- 1 | From aneris.aneris_lang Require Import ast. 2 | From aneris.aneris_lang.lib Require Import network_util_code. 3 | From aneris.examples.ping_pong_done Require Import ping_pong_done_code. 4 | 5 | Definition ping_pong_runner : expr := 6 | let: "pongaddr" := MakeAddress #"0.0.0.0" #80 in 7 | let: "pingaddr" := MakeAddress #"0.0.0.1" #80 in 8 | Start "0.0.0.0" (pong "pongaddr") ;; 9 | Start "0.0.0.1" (ping "pingaddr" "pongaddr"). 10 | -------------------------------------------------------------------------------- /aneris/examples/rcb/examples/broadcast_1_2/prog.v: -------------------------------------------------------------------------------- 1 | From aneris.aneris_lang.lib.serialization Require Import serialization_code serialization_proof. 2 | From aneris.aneris_lang Require Import proofmode. 3 | From aneris.aneris_lang.lib Require Import inject. 4 | From aneris.examples.rcb Require Import spec. 5 | 6 | Definition op_ser := int_ser. 7 | Definition op_deser := int_deser. 8 | 9 | Definition broadcast_1_2 : val := 10 | λ: "broadcast", 11 | "broadcast" #1 ;; 12 | "broadcast" #2. 13 | 14 | Definition deliver_1_2 : val := 15 | λ: "deliver", 16 | let: "m" := wait_deliver "deliver" #() in 17 | let: "x" := Fst (Fst "m") in 18 | assert: ("x" = #1) ;; 19 | let: "m" := wait_deliver "deliver" #() in 20 | let: "x" := Fst (Fst "m") in 21 | assert: ("x" = #2). 22 | 23 | Definition z0 := SocketAddressInet "0.0.0.0" 80. 24 | Definition z1 := SocketAddressInet "0.0.0.1" 80. 25 | 26 | Program Instance myparams : RCB_params := 27 | {| 28 | RCB_addresses := [z0; z1]; 29 | RCB_InvName := nroot .@ "rcbinv"; 30 | RCB_serialization := int_serialization; 31 | |}. 32 | Next Obligation. 33 | repeat constructor; set_solver. 34 | Qed. 35 | 36 | Section Main. 37 | Context `{RCB_init_function}. 38 | 39 | Definition main : expr := 40 | Start "0.0.0.0" 41 | (let: "deliver_broadcast" := init $RCB_addresses #0 in 42 | let: "broadcast" := Snd "deliver_broadcast" in 43 | broadcast_1_2 "broadcast") ;; 44 | Start "0.0.0.1" 45 | (let: "deliver_broadcast" := init $RCB_addresses #1 in 46 | let: "deliver" := Fst "deliver_broadcast" in 47 | deliver_1_2 "deliver"). 48 | End Main. 49 | -------------------------------------------------------------------------------- /aneris/examples/rcb/instantiation/events.v: -------------------------------------------------------------------------------- 1 | From stdpp Require Import base gmap. 2 | From aneris.examples.rcb.spec Require Import events. 3 | From aneris.examples.rcb.model Require Import events. 4 | 5 | Instance rcb_events : RCB_events := 6 | { ge := global_event; 7 | GE_payload := ge_payload; 8 | GE_vc := ge_time; 9 | GE_origin := ge_orig; 10 | 11 | le := local_event; 12 | LE_payload := le_payload; 13 | LE_vc := le_time; 14 | LE_origin := le_orig; 15 | 16 | erasure := erase; 17 | erasure_payload := erase_payload; 18 | erasure_vc := erase_time; 19 | erasure_origin := erase_orig 20 | }. 21 | -------------------------------------------------------------------------------- /aneris/examples/rcb/spec/base.v: -------------------------------------------------------------------------------- 1 | From RecordUpdate Require Import RecordSet. 2 | From aneris.aneris_lang Require Import network resources. 3 | From aneris.aneris_lang.lib.serialization Require Import serialization_proof. 4 | 5 | (** Arguments that user supplies to the interface *) 6 | 7 | Class RCB_params := { 8 | RCB_addresses : list socket_address; 9 | RCB_addresses_NoDup : NoDup RCB_addresses; 10 | RCB_InvName : namespace; 11 | RCB_serialization : serialization; 12 | }. 13 | 14 | Notation RCB_Serializable v := (Serializable RCB_serialization v). 15 | 16 | Record SerializableVal `{!RCB_params} := 17 | SerVal {SV_val : val; 18 | SV_ser : RCB_Serializable SV_val }. 19 | 20 | Coercion SV_val : SerializableVal >-> val. 21 | 22 | Existing Instance SV_ser. 23 | 24 | Arguments SerVal {_} _ {_}. 25 | -------------------------------------------------------------------------------- /aneris/examples/rcb/spec/spec.v: -------------------------------------------------------------------------------- 1 | (** Modular specification for the causally consistent distributed database. *) 2 | From aneris.examples.rcb.spec Require Export base events resources init. 3 | -------------------------------------------------------------------------------- /aneris/examples/reliable_communication/client_server_printing.v: -------------------------------------------------------------------------------- 1 | (* This file is automatically generated from the OCaml source file 2 | /ml_sources/examples/reliable_communication/client_server_printing.ml *) 3 | 4 | 5 | 6 | 7 | -------------------------------------------------------------------------------- /aneris/examples/reliable_communication/examples/hello_world/hello_world_code.v: -------------------------------------------------------------------------------- 1 | (* This file is automatically generated from the OCaml source file 2 | /ml_sources/examples/reliable_communication/examples/hello_world/hello_world_code.ml *) 3 | 4 | From aneris.aneris_lang Require Import ast. 5 | From aneris.examples.reliable_communication Require Import client_server_code. 6 | From aneris.aneris_lang.lib.serialization Require Import serialization_code. 7 | 8 | Definition server : val := 9 | λ: "srv_addr", 10 | let: "skt" := make_server_skt string_serializer string_serializer 11 | "srv_addr" in 12 | server_listen "skt";; 13 | let: "new_conn" := accept "skt" in 14 | let: "c" := Fst "new_conn" in 15 | let: "_clt_addr" := Snd "new_conn" in 16 | let: "req" := recv "c" in 17 | send "c" "req". 18 | 19 | Definition client : val := 20 | λ: "clt_addr" "srv_addr", 21 | let: "skt" := make_client_skt string_serializer string_serializer 22 | "clt_addr" in 23 | let: "ch" := connect "skt" "srv_addr" in 24 | send "ch" #"Hello World!". 25 | -------------------------------------------------------------------------------- /aneris/examples/reliable_communication/examples/hello_world_2/hello_world_2_code.v: -------------------------------------------------------------------------------- 1 | (* This file is automatically generated from the OCaml source file 2 | /ml_sources/examples/reliable_communication/examples/hello_world_2/hello_world_2_code.ml *) 3 | 4 | From aneris.aneris_lang Require Import ast. 5 | From aneris.examples.reliable_communication Require Import client_server_code. 6 | From aneris.aneris_lang.lib.serialization Require Import serialization_code. 7 | 8 | Definition server : val := 9 | λ: "srv_addr", 10 | let: "skt" := make_server_skt string_serializer string_serializer 11 | "srv_addr" in 12 | server_listen "skt";; 13 | let: "new_conn" := accept "skt" in 14 | let: "clt_c" := Fst "new_conn" in 15 | let: "_clt_addr" := Snd "new_conn" in 16 | let: "req" := recv "clt_c" in 17 | send "clt_c" "req". 18 | 19 | Definition client : val := 20 | λ: "clt_addr0" "clt_addr1" "srv_addr0" "srv_addr1", 21 | let: "skt0" := make_client_skt string_serializer string_serializer 22 | "clt_addr0" in 23 | let: "skt1" := make_client_skt string_serializer string_serializer 24 | "clt_addr1" in 25 | let: "ch0" := connect "skt0" "srv_addr0" in 26 | let: "ch1" := connect "skt1" "srv_addr1" in 27 | send "ch0" #"Hello World, Server 0!";; 28 | send "ch1" #"Hello World, Server 1!". 29 | -------------------------------------------------------------------------------- /aneris/examples/reliable_communication/examples/inj_elim_code.v: -------------------------------------------------------------------------------- 1 | From aneris.aneris_lang Require Import lang. 2 | 3 | Definition inj_get_left : val := 4 | λ: "v", 5 | match: "v" with 6 | InjL "w" => "w" 7 | | InjR "_" => assert: #false 8 | end. 9 | 10 | Definition inj_get_right : val := 11 | λ: "v", 12 | match: "v" with 13 | InjL "_" => assert: #false 14 | | InjR "w" => "w" 15 | end. 16 | -------------------------------------------------------------------------------- /aneris/examples/reliable_communication/examples/inj_elim_proof.v: -------------------------------------------------------------------------------- 1 | From aneris.aneris_lang.program_logic Require Import aneris_lifting. 2 | From aneris.aneris_lang Require Import proofmode. 3 | From aneris.examples.reliable_communication.examples Require Import inj_elim_code. 4 | 5 | Section with_Σ. 6 | Context `{anerisG Σ Mdl}. 7 | 8 | Lemma inj_get_left_spec ip E v : 9 | ⊢ WP inj_get_left (InjLV v) @[ip] E {{ w, ⌜v = w⌝ }}. 10 | Proof. wp_lam. by wp_pures. Qed. 11 | 12 | Lemma inj_get_right_spec ip E v : 13 | ⊢ WP inj_get_right (InjRV v) @[ip] E {{ w, ⌜v = w⌝ }}. 14 | Proof. wp_lam. by wp_pures. Qed. 15 | 16 | End with_Σ. 17 | -------------------------------------------------------------------------------- /aneris/examples/reliable_communication/examples/messages_in_order/messages_in_order_code.v: -------------------------------------------------------------------------------- 1 | (* This file is automatically generated from the OCaml source file 2 | /ml_sources/examples/reliable_communication/examples/messages_in_order/messages_in_order_code.ml *) 3 | 4 | From aneris.aneris_lang Require Import ast. 5 | From aneris.aneris_lang.lib.serialization Require Import serialization_code. 6 | From aneris.examples.reliable_communication Require Import client_server_code. 7 | 8 | Definition server : val := 9 | λ: "srv", 10 | #() (* unsafe (fun () -> Printf.printf "Install server.\n%!"); *);; 11 | #() (* unsafe (fun () -> Printf.printf "Creating socket.\n%!"); *);; 12 | let: "s" := make_server_skt int_serializer int_serializer "srv" in 13 | #() (* unsafe (fun () -> Printf.printf "Start listening.\n%!"); *);; 14 | server_listen "s";; 15 | let: "new_conn" := accept "s" in 16 | let: "c" := Fst "new_conn" in 17 | let: "_clt" := Snd "new_conn" in 18 | let: "_r1" := let: "m" := recv "c" in 19 | send "c" "m" in 20 | let: "_r2" := let: "m" := recv "c" in 21 | send "c" "m" in 22 | let: "_r3" := let: "m" := recv "c" in 23 | send "c" "m" in 24 | #(). 25 | 26 | Definition client : val := 27 | λ: "clt" "srv", 28 | #() (* unsafe (fun () -> Printf.printf "Install client.\n%!"); *);; 29 | #() (* unsafe (fun () -> Printf.printf "Creating socket.\n%!"); *);; 30 | let: "s" := make_client_skt int_serializer int_serializer "clt" in 31 | #() (* unsafe (fun () -> Printf.printf "Connecting to the server.\n%!"); *);; 32 | let: "c" := connect "s" "srv" in 33 | send "c" #1;; 34 | send "c" #2;; 35 | send "c" #3;; 36 | let: "m1" := recv "c" in 37 | let: "m2" := recv "c" in 38 | let: "m3" := recv "c" in 39 | assert: (("m1" = #1) && (("m2" = #2) && ("m3" = #3))). 40 | -------------------------------------------------------------------------------- /aneris/examples/reliable_communication/examples/messages_in_order_loop/messages_in_order_loop_code.v: -------------------------------------------------------------------------------- 1 | (* This file is automatically generated from the OCaml source file 2 | /ml_sources/examples/reliable_communication/examples/messages_in_order_loop/messages_in_order_loop_code.ml *) 3 | 4 | From aneris.aneris_lang Require Import ast. 5 | From aneris.aneris_lang.lib.serialization Require Import serialization_code. 6 | From aneris.examples.reliable_communication Require Import client_server_code. 7 | 8 | Definition int_s := int_serializer. 9 | 10 | Definition str_s := string_serializer. 11 | 12 | Definition echo_loop : val := 13 | rec: "echo_loop" "c" := 14 | let: "req" := recv "c" in 15 | send "c" (strlen "req");; 16 | "echo_loop" "c". 17 | 18 | Definition accept_loop : val := 19 | λ: "s", 20 | letrec: "loop" <> := 21 | let: "c" := Fst (accept "s") in 22 | Fork (echo_loop "c");; 23 | "loop" #() in 24 | "loop" #(). 25 | 26 | Definition server : val := 27 | λ: "srv", 28 | let: "s" := make_server_skt int_s str_s "srv" in 29 | server_listen "s";; 30 | Fork (accept_loop "s"). 31 | 32 | Definition client : val := 33 | λ: "clt" "srv" "s1" "s2", 34 | let: "s" := make_client_skt str_s int_s "clt" in 35 | let: "c" := connect "s" "srv" in 36 | send "c" "s1";; 37 | send "c" "s2";; 38 | let: "m1" := recv "c" in 39 | let: "m2" := recv "c" in 40 | assert: (("m1" = (strlen "s1")) && ("m2" = (strlen "s2"))). 41 | 42 | Definition client_0 : val := 43 | λ: "clt" "srv", client "clt" "srv" #"carpe" #"diem". 44 | -------------------------------------------------------------------------------- /aneris/examples/reliable_communication/examples/repdb_leader_followers/causality_example_code.v: -------------------------------------------------------------------------------- 1 | (* This file is automatically generated from the OCaml source file 2 | /ml_sources/examples/reliable_communication/examples/repdb_leader_followers/causality_example_code.ml *) 3 | 4 | From aneris.aneris_lang Require Import ast. 5 | From aneris.aneris_lang.lib.serialization Require Import serialization_code. 6 | From aneris.examples.reliable_communication.lib.repdb Require Import repdb_code. 7 | 8 | Definition do_writes : val := λ: "wr", "wr" #"x" #37;; 9 | "wr" #"y" #1. 10 | 11 | Definition wait_on_read : val := 12 | λ: "rd" "k" "v", 13 | letrec: "loop" <> := 14 | let: "res" := "rd" "k" in 15 | (if: "res" = (SOME "v") 16 | then #() 17 | else 18 | #() (* unsafe (fun () -> Unix.sleepf 2.0); loop ()) *);; 19 | "loop" #()) in 20 | "loop" #(). 21 | 22 | Definition do_reads : val := 23 | λ: "rd", 24 | wait_on_read "rd" #"y" #1;; 25 | let: "vx" := "rd" #"x" in 26 | assert: ("vx" = (SOME #37)). 27 | 28 | Definition node0 : val := 29 | λ: "clt_addr0" "db_laddr", 30 | let: "db_funs" := init_client_leader_proxy int_serializer "clt_addr0" 31 | "db_laddr" in 32 | let: "wr" := Fst "db_funs" in 33 | let: "_rd" := Snd "db_funs" in 34 | do_writes "wr". 35 | 36 | Definition node1 : val := 37 | λ: "clt_addr1" "faddr", 38 | let: "rd" := init_client_follower_proxy int_serializer "clt_addr1" "faddr" in 39 | do_reads "rd". 40 | -------------------------------------------------------------------------------- /aneris/examples/reliable_communication/examples/sharding_examples/causality_example_code.v: -------------------------------------------------------------------------------- 1 | (* This file is automatically generated from the OCaml source file 2 | /ml_sources/examples/reliable_communication/examples/sharding_examples/causality_example_code.ml *) 3 | 4 | From aneris.aneris_lang Require Import ast. 5 | From aneris.aneris_lang.lib.serialization Require Import serialization_code. 6 | From aneris.examples.reliable_communication.lib.sharding Require Import sharding_code. 7 | 8 | Definition do_writes : val := λ: "wr", "wr" #"x" #37;; 9 | "wr" #"y" #1. 10 | 11 | Definition wait_on_read : val := 12 | λ: "rd" "k" "v", 13 | letrec: "loop" <> := 14 | let: "res" := "rd" "k" in 15 | (if: "res" = (SOME "v") 16 | then #() 17 | else 18 | #() (* unsafe (fun () -> Unix.sleepf 2.0); loop ()) *);; 19 | "loop" #()) in 20 | "loop" #(). 21 | 22 | Definition do_reads : val := 23 | λ: "rd", 24 | wait_on_read "rd" #"y" #1;; 25 | let: "vx" := "rd" #"x" in 26 | assert: ("vx" = (SOME #37)). 27 | 28 | Definition node0 : val := 29 | λ: "clt_addr0" "db_addr", 30 | let: "db_funs" := init_client string_serializer int_serializer "clt_addr0" 31 | "db_addr" in 32 | let: "wr" := Fst "db_funs" in 33 | do_writes "wr". 34 | 35 | Definition node1 : val := 36 | λ: "clt_addr1" "db_addr", 37 | let: "db_funs" := init_client string_serializer int_serializer "clt_addr1" 38 | "db_addr" in 39 | let: "rd" := Snd "db_funs" in 40 | do_reads "rd". 41 | 42 | Definition hash : val := λ: "k", (if: "k" = #"x" 43 | then #0 44 | else #1). 45 | -------------------------------------------------------------------------------- /aneris/examples/reliable_communication/lib/ddb/ddb_serialization_code.v: -------------------------------------------------------------------------------- 1 | (* This file is automatically generated from the OCaml source file 2 | /ml_sources/examples/reliable_communication/lib/ddb/ddb_serialization_code.ml *) 3 | 4 | From aneris.aneris_lang Require Import ast. 5 | From aneris.aneris_lang.lib Require Import map_code. 6 | From aneris.aneris_lang.lib.serialization Require Import serialization_code. 7 | From aneris.examples.reliable_communication Require Import client_server_code. 8 | 9 | Definition write_serializer val_ser := 10 | prod_serializer string_serializer val_ser. 11 | 12 | Definition read_serializer := string_serializer. 13 | 14 | Definition request_serializer val_ser := 15 | sum_serializer (write_serializer val_ser) read_serializer. 16 | 17 | Definition reply_serializer val_ser := 18 | sum_serializer unit_serializer (option_serializer val_ser). 19 | -------------------------------------------------------------------------------- /aneris/examples/reliable_communication/lib/dlm/dlm_prelude.v: -------------------------------------------------------------------------------- 1 | From aneris.aneris_lang Require Import lang. 2 | From aneris.aneris_lang.lib Require Import inject list_proof. 3 | From aneris.aneris_lang.program_logic Require Import aneris_weakestpre. 4 | 5 | Class DL_params := { 6 | DL_server_addr : socket_address; 7 | DL_namespace : namespace; 8 | }. 9 | -------------------------------------------------------------------------------- /aneris/examples/reliable_communication/lib/mt_server/user_params.v: -------------------------------------------------------------------------------- 1 | From aneris.aneris_lang Require Import lang. 2 | From aneris.aneris_lang.lib Require Import lock_proof monitor_proof serialization_proof. 3 | From aneris.aneris_lang.program_logic Require Import aneris_weakestpre. 4 | From aneris.examples.reliable_communication.prelude Require Import ser_inj. 5 | From actris.channel Require Import proto. 6 | 7 | Set Default Proof Using "Type". 8 | 9 | Canonical Structure valO := leibnizO val. 10 | Notation iProto Σ := (iProto Σ val). 11 | Notation iMsg Σ := (iMsg Σ val). 12 | 13 | Import lock_proof. 14 | 15 | Class MTS_user_params `{ !anerisG Mdl Σ, !lockG Σ } := 16 | { (* Requests. *) 17 | MTS_req_ser : serialization; 18 | MTS_req_ser_inj : ser_is_injective MTS_req_ser; 19 | MTS_req_ser_inj_alt : ser_is_injective_alt MTS_req_ser; 20 | MTS_req_data : Type; 21 | (* Replies. *) 22 | MTS_rep_ser : serialization; 23 | MTS_rep_ser_inj : ser_is_injective MTS_rep_ser; 24 | MTS_rep_ser_inj_alt : ser_is_injective_alt MTS_rep_ser; 25 | MTS_rep_data : Type; 26 | MTS_handler_pre : val → MTS_req_data → iProp Σ; 27 | MTS_handler_post : val → MTS_req_data → MTS_rep_data → iProp Σ; 28 | MTS_saddr : socket_address; 29 | MTS_mN : namespace; 30 | }. 31 | 32 | Arguments MTS_user_params {_ _ _ _}. 33 | 34 | Definition handler_spec `{MTS_user_params} (handler : val) : iProp Σ := 35 | ∀ reqv reqd, 36 | {{{ MTS_handler_pre reqv reqd }}} 37 | handler reqv @[ip_of_address MTS_saddr] 38 | {{{ repv repd, RET repv; 39 | ⌜Serializable MTS_rep_ser repv⌝ ∗ 40 | MTS_handler_post repv reqd repd }}}. 41 | 42 | Class MTS_resources `{!anerisG Mdl Σ} := { 43 | MTSCanRequest : ip_address → val → iProp Σ; 44 | }. 45 | -------------------------------------------------------------------------------- /aneris/examples/reliable_communication/lib/repdb/log_code.v: -------------------------------------------------------------------------------- 1 | (* This file is automatically generated from the OCaml source file 2 | /ml_sources/examples/reliable_communication/lib/repdb/log_code.ml *) 3 | 4 | From aneris.aneris_lang Require Import ast. 5 | From aneris.aneris_lang.lib Require Import list_code. 6 | 7 | (** Operations on log of requests *) 8 | 9 | Definition log_create : val := λ: <>, ref ([], #0). 10 | 11 | Definition log_add_entry : val := 12 | λ: "log" "req", 13 | let: "lp" := ! "log" in 14 | let: "data" := Fst "lp" in 15 | let: "next" := Snd "lp" in 16 | let: "data'" := list_append "data" ["req"] in 17 | "log" <- ("data'", ("next" + #1)). 18 | 19 | Definition log_next : val := λ: "log", Snd ! "log". 20 | 21 | Definition log_length : val := λ: "log", Snd ! "log". 22 | 23 | Definition log_get : val := λ: "log" "i", list_nth (Fst ! "log") "i". 24 | 25 | Definition log_wait_until : val := 26 | λ: "log" "mon" "i", 27 | letrec: "aux" <> := 28 | let: "n" := log_next "log" in 29 | (if: "n" = "i" 30 | then monitor_wait "mon";; 31 | "aux" #() 32 | else assert: ("i" < "n")) in 33 | (if: ("i" < #0) || ((log_next "log") < "i") 34 | then assert: #false 35 | else "aux" #()). 36 | -------------------------------------------------------------------------------- /aneris/examples/reliable_communication/lib/repdb/resources/ras.v: -------------------------------------------------------------------------------- 1 | From iris.algebra Require Import auth gmap dfrac. 2 | From iris.algebra.lib Require Import mono_list. 3 | From iris.bi.lib Require Import fractional. 4 | From aneris.lib Require Import gen_heap_light. 5 | From aneris.aneris_lang Require Import lang resources. 6 | From aneris.aneris_lang.lib Require Import lock_proof. 7 | From aneris.examples.reliable_communication.lib.repdb.spec 8 | Require Import db_params time events. 9 | From aneris.examples.reliable_communication.lib.repdb 10 | Require Import model. 11 | 12 | Import gen_heap_light. 13 | Import lock_proof. 14 | 15 | 16 | (* -------------------------------------------------------------------------- *) 17 | (** Resource Algebras and global ghost names needed to define resources. *) 18 | 19 | Class IDBG Σ := 20 | { IDBG_Global_mem :> 21 | inG Σ (authR (gen_heapUR Key (option write_event))); 22 | IDBG_Global_history_mono :> 23 | inG Σ (mono_listUR write_eventO); 24 | IDBG_Known_replog :> 25 | inG Σ (authR (gmapUR socket_address (agreeR gnameO))); 26 | (* IDBG_free_replogG :> *) 27 | (* inG Σ (gset_disjUR socket_address); *) 28 | IDBG_lockG :> lockG Σ; 29 | IDBG_known_replog_name : gname; 30 | (* IDBG_free_replog_set_name : gname; *) 31 | }. 32 | -------------------------------------------------------------------------------- /aneris/examples/reliable_communication/lib/repdb/spec/db_params.v: -------------------------------------------------------------------------------- 1 | From RecordUpdate Require Import RecordSet. 2 | From aneris.aneris_lang Require Import network resources. 3 | From aneris.aneris_lang.lib.serialization Require Import serialization_proof. 4 | From aneris.examples.reliable_communication.prelude Require Import ser_inj. 5 | 6 | Definition Key := string. 7 | 8 | (** Arguments that user supplies to the interface *) 9 | 10 | Class DB_params := { 11 | DB_addr : socket_address; 12 | DB_addrF : socket_address; 13 | DB_followers : gset socket_address; 14 | DB_keys : gset Key; 15 | DB_InvName : namespace; 16 | DB_serialization : serialization; 17 | DB_ser_inj : ser_is_injective DB_serialization; 18 | DB_ser_inj_alt : ser_is_injective_alt DB_serialization; 19 | }. 20 | 21 | Notation DB_Serializable v := (Serializable DB_serialization v). 22 | 23 | Record SerializableVal `{!DB_params} := 24 | SerVal {SV_val : val; 25 | SV_ser : DB_Serializable SV_val }. 26 | 27 | Coercion SV_val : SerializableVal >-> val. 28 | 29 | Existing Instance SV_ser. 30 | 31 | Arguments SerVal {_} _ {_}. 32 | 33 | Definition socket_address_to_str (sa : socket_address) : string := 34 | match sa with SocketAddressInet ip p => ip +:+ (string_of_pos p) end. 35 | -------------------------------------------------------------------------------- /aneris/examples/reliable_communication/lib/repdb/spec/ras.v: -------------------------------------------------------------------------------- 1 | From iris.algebra Require Import auth gmap excl excl_auth. 2 | From iris.algebra.lib Require Import mono_list. 3 | From aneris.lib Require Import gen_heap_light. 4 | From aneris.aneris_lang.lib Require Import lock_proof. 5 | From aneris.examples.reliable_communication.lib.repdb.spec 6 | Require Import db_params time events resources. 7 | 8 | 9 | Class DBG `{!DB_time} Σ := 10 | { DBG_Global_mem :> inG Σ (authR (gen_heapUR Key (option we))); 11 | DBG_Global_history_mono :> inG Σ (mono_listUR (leibnizO we)); 12 | DBG_Known_replog :> inG Σ (authR (gmapUR socket_address (agreeR gnameO))); 13 | (* DBG_free_replogG :> inG Σ (gset_disjUR socket_address); *) 14 | DBG_lockG :> lockG Σ; 15 | DBG_known_replog_name : gname; 16 | (* DBG_free_replog_set_name : gname; *) 17 | }. 18 | 19 | Class DBPreG `{!DB_time} Σ := 20 | { DB_preG_Global_mem :> inG Σ (authR (gen_heapUR Key (option we))); 21 | DB_preG_Global_history_mono :> inG Σ (mono_listUR (leibnizO we)); 22 | DB_preG_Known_replog :> 23 | inG Σ (authR (gmapUR socket_address (agreeR gnameO))); 24 | (* DB_preG_free_replogG :> inG Σ (gset_disjUR socket_address); *) 25 | DB_preG_lockG :> lockG Σ; 26 | }. 27 | 28 | Definition DBΣ `{!DB_time} : gFunctors := 29 | #[GFunctor (authR (gen_heapUR Key (option we))); 30 | GFunctor (mono_listUR (leibnizO we)); 31 | GFunctor (authR (gmapUR socket_address (agreeR gnameO))); 32 | (* GFunctor (gset_disjUR socket_address); *) 33 | lockΣ]. 34 | 35 | Instance subG_DB_preGΣ `{!DB_time, !lockG Σ} : subG DBΣ Σ → DBPreG Σ. 36 | Proof. solve_inG. Qed. 37 | -------------------------------------------------------------------------------- /aneris/examples/reliable_communication/lib/repdb/spec/time.v: -------------------------------------------------------------------------------- 1 | From stdpp Require Import gmap. 2 | 3 | (** Abstract Notion of Timestamps with Total Order. *) 4 | 5 | Section Time. 6 | 7 | 8 | Class DB_time := { 9 | Time : Type; 10 | TM_lt : relation Time; 11 | TM_lt_TO :> StrictOrder TM_lt; 12 | TM_lt_tricho : ∀ m n : Time, TM_lt m n ∨ m = n ∨ TM_lt n m; 13 | TM_EqDecision :> EqDecision Time; 14 | TM_Countable :> Countable Time; 15 | (* TM_max : Time → Time → Time. TODO *) 16 | }. 17 | 18 | (* Class Timed {dbt: DB_time} (T : Type) := time : T → Time. *) 19 | 20 | (* Notation "s '<ₜ' t" := *) 21 | (* (TM_lt (time s) (time t)) (at level 70, no associativity). *) 22 | (* Notation "t1 '≤ₜ' t2" := *) 23 | (* (TM_lt (time t1) (time t2) ∨ (time t1 = time t2)) *) 24 | (* (at level 70, no associativity). *) 25 | (* Notation "t1 '=ₜ' t2" := *) 26 | (* (time t1 = time t2) (at level 70, no associativity). *) 27 | End Time. 28 | 29 | (* 30 | Notation "s '<ₜ@{' d '}' t" := 31 | (TM_lt (@time d _ _ s) (@time d _ _ t)) 32 | (at level 70, no associativity, format "s '<ₜ@{' d '}' t"). 33 | Notation "s '≤ₜ@{' d '}' t" := 34 | (TM_lt (@time d _ _ s) (@time d _ _ t) ∨ (@time d _ _ s) = (@time d _ _ t)) 35 | (at level 70, no associativity, format "s '≤ₜ@{' d '}' t"). 36 | Notation "s '=ₜ@{' d '}' t" := 37 | ((@time d _ _ s) = (@time d _ _ t)) 38 | (at level 70, no associativity, format "s '=ₜ@{' d '}' t"). 39 | *) 40 | 41 | (* Notation "s '<ₜ' t" := *) 42 | (* (TM_lt (time s) (time t)) (at level 70, no associativity). *) 43 | (* Notation "s '≤ₜ' t" := *) 44 | (* (TM_lt (time s) (time t) ∨ (time s = time t)) (at level 70, no associativity). *) 45 | (* Notation "s '=ₜ' t" := *) 46 | (* (time s = time t) (at level 70, no associativity). *) 47 | -------------------------------------------------------------------------------- /aneris/examples/reliable_communication/proof/notes: -------------------------------------------------------------------------------- 1 | 2 | Features: 3 | - Concurrent send and receive (unbounded) buffers 4 | - Single port for sending and receiving (for individual client) 5 | - Asynchronous server/client connection 6 | + Handshake 7 | - Multiple clients connecting to single server (on same port) 8 | 9 | 10 | 11 | Future features: 12 | - Sliding window 13 | 14 | 15 | 16 | 17 | Acknowledgement does not strictly need to carry evidence of received msg: 18 | - We might want to add assertion on it, to more strongly guarantee that communication more well-behaved. 19 | - NB: CANNOT send evidence of `Rs i` AT ALL, as it is only generated when user-land commits to receiving 20 | + INSTEAD, evidence of `ackId` might be sent. 21 | 22 | 23 | Sequence ID does not necessarily have to live in "canonical send/receive". 24 | - Alternative to ID'd messages would be a queue of messages where the ID can be 25 | computed based on the Sequence ID LB, and the position in the queue. 26 | 27 | Sequence ID upper bound is not needed. 28 | -------------------------------------------------------------------------------- /aneris/examples/reliable_communication/spec/api_symbols.v: -------------------------------------------------------------------------------- 1 | From aneris.aneris_lang Require Import lang. 2 | From aneris.aneris_lang.lib Require Import serialization_proof. 3 | From aneris.examples.reliable_communication Require Import client_server_code. 4 | 5 | Class Reliable_communication_API := 6 | { 7 | (* type ('a, 'b) client_skt; *) 8 | (* type ('a, 'b) server_skt; *) 9 | (* type ('a, 'b) chan_descr; *) 10 | (* val make_client_skt : 'a serializer -> 'b serializer -> saddr -> ('a, 'b) client_skt; *) 11 | make_client_skt : serializer → serializer → val; 12 | (* val make_server_skt : 'a serializer -> 'b serializer -> saddr -> ('a, 'b) server_skt; *) 13 | make_server_skt : serializer → serializer → val; 14 | (* val server_listen : ('a, 'b) server_skt -> unit; *) 15 | server_listen : val; 16 | (* val accept : ('a, 'b) server_skt -> ('a, 'b) chan_descr * saddr; *) 17 | accept : val; 18 | (* val connect : ('a, 'b) client_skt -> saddr -> ('a, 'b) chan_descr; *) 19 | connect : val; 20 | (* val send : ('a, 'b) chan_descr -> 'a -> unit; *) 21 | send : val; 22 | (* val try_recv : ('a, 'b) chan_descr -> 'b option; *) 23 | try_recv : val; 24 | (* val recv : ('a, 'b) chan_descr -> 'b; *) 25 | recv : val; 26 | }. 27 | 28 | 29 | Global Instance Reliable_communication_API_instance : Reliable_communication_API := 30 | {| make_client_skt := client_server_code.make_client_skt; 31 | make_server_skt := client_server_code.make_server_skt; 32 | server_listen := client_server_code.server_listen; 33 | accept := client_server_code.accept; 34 | connect := client_server_code.connect; 35 | send := client_server_code.send; 36 | try_recv := client_server_code.try_recv; 37 | recv := client_server_code.recv |}. 38 | -------------------------------------------------------------------------------- /aneris/examples/reliable_communication/user_params.v: -------------------------------------------------------------------------------- 1 | From aneris.aneris_lang Require Import lang. 2 | From aneris.aneris_lang.lib Require Import serialization_proof. 3 | From aneris.aneris_lang.program_logic Require Import aneris_weakestpre. 4 | From aneris.examples.reliable_communication.prelude Require Import ser_inj. 5 | From actris.channel Require Import proto. 6 | 7 | Set Default Proof Using "Type". 8 | 9 | Canonical Structure valO := leibnizO val. 10 | Notation iProto Σ := (iProto Σ val). 11 | Notation iMsg Σ := (iMsg Σ val). 12 | 13 | Class Reliable_communication_service_params `{ !anerisG Mdl Σ } := 14 | { RCParams_clt_ser : serialization; (* client_send, server_receive *) 15 | RCParams_srv_ser : serialization; (* server_send, client_receive *) 16 | RCParams_srv_ser_inj : ser_is_injective RCParams_srv_ser; 17 | RCParams_srv_ser_inj_alt : ser_is_injective_alt RCParams_srv_ser; 18 | RCParams_clt_ser_inj : ser_is_injective RCParams_clt_ser; 19 | RCParams_clt_ser_inj_alt : ser_is_injective_alt RCParams_clt_ser; 20 | RCParams_srv_saddr : socket_address; 21 | RCParams_protocol : iProto Σ; 22 | RCParams_srv_N : namespace 23 | }. 24 | 25 | Arguments Reliable_communication_service_params {_ _ _}. 26 | -------------------------------------------------------------------------------- /aneris/examples/transaction_commit/two_phase_runner_code.v: -------------------------------------------------------------------------------- 1 | From aneris.aneris_lang Require Import ast. 2 | From aneris.aneris_lang.lib Require Import set_code. 3 | From aneris.examples.transaction_commit Require Import two_phase_code. 4 | 5 | Definition runner : expr := 6 | let: "TM" := MakeAddress #"tm" #80 in 7 | let: "RM1" := MakeAddress #"rm.01" #80 in 8 | let: "RM2" := MakeAddress #"rm.02" #80 in 9 | let: "RM3" := MakeAddress #"rm.03" #80 in 10 | let: "RMs" := {[ "RM1"; "RM2"; "RM3" ]} in 11 | Start "rm.01" (resource_manager "RM1" "TM");; 12 | Start "rm.02" (resource_manager "RM2" "TM");; 13 | Start "rm.03" (resource_manager "RM3" "TM");; 14 | Start "tm" (transaction_manager "TM" "RMs"). 15 | -------------------------------------------------------------------------------- /aneris/examples/transactional_consistency/aux_defs.v: -------------------------------------------------------------------------------- 1 | From iris.algebra Require Import auth gmap excl excl_auth frac_auth. 2 | From aneris.algebra Require Import monotone. 3 | From aneris.aneris_lang Require Import network resources proofmode. 4 | From aneris.aneris_lang.lib Require Import 5 | list_proof inject lock_proof. 6 | From aneris.aneris_lang.lib.serialization 7 | Require Import serialization_proof. 8 | From aneris.aneris_lang.program_logic Require Import lightweight_atomic. 9 | From aneris.examples.transactional_consistency 10 | Require Import code_api user_params. 11 | 12 | Definition Vals : Set := gset val. 13 | 14 | Inductive local_state : Type := 15 | | CanStart 16 | | Active (s : gset Key). -------------------------------------------------------------------------------- /aneris/examples/transactional_consistency/code_api.v: -------------------------------------------------------------------------------- 1 | From aneris.aneris_lang Require Import ast. 2 | 3 | Class KVS_transaction_api := 4 | { TC_init_server : serializer -> val; 5 | TC_start : val; 6 | TC_read : val; 7 | TC_write : val; 8 | TC_commit : val; 9 | TC_init_client_proxy : serializer -> val 10 | }. 11 | -------------------------------------------------------------------------------- /aneris/examples/transactional_consistency/read_committed/examples/dirty_read/dirty_read_code.v: -------------------------------------------------------------------------------- 1 | (* This file is automatically generated from the OCaml source file 2 | /ml_sources/examples/transactional_consistency/read_committed/examples/dirty_read/dirty_read_code.ml *) 3 | 4 | From aneris.aneris_lang Require Import ast. 5 | From aneris.aneris_lang.lib.serialization Require Import serialization_code. 6 | From aneris.examples.transactional_consistency.snapshot_isolation Require Import snapshot_isolation_code. 7 | From aneris.examples.transactional_consistency.snapshot_isolation.util Require Import util_code. 8 | 9 | Definition transaction1 : val := 10 | λ: "cst", start "cst";; 11 | write "cst" #"x" #1;; 12 | loop #(). 13 | 14 | Definition transaction2 : val := 15 | λ: "cst", 16 | start "cst";; 17 | let: "vx" := read "cst" #"x" in 18 | assert: ("vx" = NONE);; 19 | commitU "cst". 20 | 21 | Definition transaction1_client : val := 22 | λ: "caddr" "kvs_addr", 23 | let: "cst" := init_client_proxy int_serializer "caddr" "kvs_addr" in 24 | transaction1 "cst". 25 | 26 | Definition transaction2_client : val := 27 | λ: "caddr" "kvs_addr", 28 | let: "cst" := init_client_proxy int_serializer "caddr" "kvs_addr" in 29 | transaction2 "cst". 30 | 31 | Definition server : val := λ: "srv", init_server int_serializer "srv". 32 | -------------------------------------------------------------------------------- /aneris/examples/transactional_consistency/read_committed/examples/trace_proof_of_concept/trace_proof_of_concept_code.v: -------------------------------------------------------------------------------- 1 | From aneris.aneris_lang Require Import ast. 2 | From aneris.aneris_lang.lib.serialization Require Import serialization_code. 3 | From aneris.examples.transactional_consistency.snapshot_isolation Require Import wrapped_snapshot_isolation_code. 4 | From aneris.examples.transactional_consistency.snapshot_isolation.util Require Import util_code. 5 | 6 | Definition transaction1 : val := 7 | λ: "cst", start "cst";; 8 | write "cst" #"x" #1;; 9 | loop #(). 10 | 11 | Definition transaction2 : val := 12 | λ: "cst", 13 | start "cst";; 14 | let: "vx" := read "cst" #"x" in 15 | assert: ("vx" = NONE);; 16 | commit "cst" ;; 17 | #(). 18 | 19 | Definition transaction1_client : val := 20 | λ: "caddr" "kvs_addr", 21 | let: "cst" := init_client_proxy int_serializer "caddr" "kvs_addr" in 22 | transaction1 "cst". 23 | 24 | Definition transaction2_client : val := 25 | λ: "caddr" "kvs_addr", 26 | let: "cst" := init_client_proxy int_serializer "caddr" "kvs_addr" in 27 | transaction2 "cst". 28 | 29 | Definition server : val := λ: "srv", init_server int_serializer "srv". 30 | -------------------------------------------------------------------------------- /aneris/examples/transactional_consistency/read_committed/trace/adequacy_trace.v: -------------------------------------------------------------------------------- 1 | From aneris.examples.transactional_consistency.read_committed.specs Require Import specs resources. 2 | From aneris.examples.transactional_consistency Require Import state_based_model. 3 | From trillium.prelude Require Import classical_instances. 4 | From trillium.program_logic Require Import language. 5 | From trillium Require Import finitary. 6 | From aneris.aneris_lang Require Import adequacy aneris_lang proofmode adequacy_no_model adequacy_trace. 7 | From iris.base_logic.lib Require Import invariants. 8 | From aneris.examples.transactional_consistency Require Import resource_algebras code_api wrapped_library user_params. 9 | From aneris.examples.transactional_consistency.read_committed.trace Require implication_trace. 10 | 11 | Theorem adequacy_trace_rc Σ `{anerisPreG Σ unit_model, KVSG Σ} ip 12 | (e : expr) (σ : aneris_lang.state) (lib : KVS_transaction_api) 13 | (U : User_params) (A : gset socket_address) (IPs : gset ip_address) : 14 | KVS_InvName = nroot .@ "kvs_inv" → 15 | state_heaps σ = {[ip:=∅]} → 16 | state_sockets σ = {[ip:=∅]} → 17 | state_ms σ = ∅ → 18 | state_trace σ = [] → 19 | ip ∉ IPs → 20 | (∀ `{anerisG Σ}, ⊢ |={⊤}=> RC_spec A lib) → 21 | (∀ `{anerisG Σ}, ⊢ 22 | {{{ RC_spec A (KVS_wrapped_api lib) 23 | ∗ unallocated A ∗ ([∗ set] a ∈ A, a ⤳ (∅, ∅)) ∗ ([∗ set] ip ∈ IPs, free_ip ip) }}} 24 | e @[ip] 25 | {{{ v, RET v; True }}}) → 26 | ∀ σ' e', 27 | rtc step ([(mkExpr ip e)], σ) (e', σ') → 28 | valid_trace_rc (state_trace σ'). 29 | Proof. 30 | intros. 31 | eapply adequacy_trace; try done; first apply valid_trace_rc_empty. 32 | iIntros (Ag) "(Htr & #Hinv)". 33 | iMod H6 as "Hspec". 34 | iMod (implication_trace.library_implication with "[$Htr $Hspec $Hinv]") 35 | as "Hspec"; last done. 36 | by iPureIntro. 37 | Qed. -------------------------------------------------------------------------------- /aneris/examples/transactional_consistency/read_uncommitted/examples/read_own_data/read_own_data_code.v: -------------------------------------------------------------------------------- 1 | (* This file is automatically generated from the OCaml source file 2 | /ml_sources/examples/transactional_consistency/read_uncommitted/examples/read_own_data/read_own_data_code.ml *) 3 | 4 | From aneris.aneris_lang Require Import ast. 5 | From aneris.aneris_lang.lib.serialization Require Import serialization_code. 6 | From aneris.examples.transactional_consistency.snapshot_isolation Require Import snapshot_isolation_code. 7 | From aneris.examples.transactional_consistency.snapshot_isolation.util Require Import util_code. 8 | 9 | Definition transaction1 : val := 10 | λ: "cst", start "cst";; 11 | write "cst" #"x" #1;; 12 | commitU "cst". 13 | 14 | Definition transaction2 : val := 15 | λ: "cst", 16 | start "cst";; 17 | write "cst" #"x" #2;; 18 | let: "vx" := read "cst" #"x" in 19 | assert: ("vx" = (SOME #2));; 20 | commitU "cst". 21 | 22 | Definition transaction1_client : val := 23 | λ: "caddr" "kvs_addr", 24 | let: "cst" := init_client_proxy int_serializer "caddr" "kvs_addr" in 25 | transaction1 "cst". 26 | 27 | Definition transaction2_client : val := 28 | λ: "caddr" "kvs_addr", 29 | let: "cst" := init_client_proxy int_serializer "caddr" "kvs_addr" in 30 | transaction2 "cst". 31 | 32 | Definition server : val := λ: "srv", init_server int_serializer "srv". 33 | -------------------------------------------------------------------------------- /aneris/examples/transactional_consistency/read_uncommitted/examples/read_uncommitted_data/read_uncommitted_data_code.v: -------------------------------------------------------------------------------- 1 | (* This file is automatically generated from the OCaml source file 2 | /ml_sources/examples/transactional_consistency/read_uncommitted/examples/read_uncommitted_data/read_uncommitted_data_code.ml *) 3 | 4 | From aneris.aneris_lang Require Import ast. 5 | From aneris.aneris_lang.lib.serialization Require Import serialization_code. 6 | From aneris.examples.transactional_consistency.snapshot_isolation Require Import snapshot_isolation_code. 7 | From aneris.examples.transactional_consistency.snapshot_isolation.util Require Import util_code. 8 | 9 | Definition transaction1 : val := 10 | λ: "cst", start "cst";; 11 | write "cst" #"x" #1;; 12 | loop #(). 13 | 14 | Definition transaction2 : val := 15 | λ: "cst", 16 | start "cst";; 17 | let: "vx" := read "cst" #"x" in 18 | assert: (("vx" = NONE) || ("vx" = (SOME #1)));; 19 | commitU "cst". 20 | 21 | Definition transaction1_client : val := 22 | λ: "caddr" "kvs_addr", 23 | let: "cst" := init_client_proxy int_serializer "caddr" "kvs_addr" in 24 | transaction1 "cst". 25 | 26 | Definition transaction2_client : val := 27 | λ: "caddr" "kvs_addr", 28 | let: "cst" := init_client_proxy int_serializer "caddr" "kvs_addr" in 29 | transaction2 "cst". 30 | 31 | Definition server : val := λ: "srv", init_server int_serializer "srv". 32 | -------------------------------------------------------------------------------- /aneris/examples/transactional_consistency/read_uncommitted/trace/adequacy_trace.v: -------------------------------------------------------------------------------- 1 | From aneris.examples.transactional_consistency.read_uncommitted.specs Require Import specs resources. 2 | From aneris.examples.transactional_consistency Require Import state_based_model. 3 | From trillium.prelude Require Import classical_instances. 4 | From trillium.program_logic Require Import language. 5 | From trillium Require Import finitary. 6 | From aneris.aneris_lang Require Import adequacy aneris_lang proofmode adequacy_no_model adequacy_trace. 7 | From iris.base_logic.lib Require Import invariants. 8 | From aneris.examples.transactional_consistency Require Import resource_algebras code_api wrapped_library user_params. 9 | From aneris.examples.transactional_consistency.read_uncommitted.trace Require implication_trace. 10 | 11 | Theorem adequacy_trace_ru Σ `{anerisPreG Σ unit_model, KVSG Σ} ip 12 | (e : expr) (σ : aneris_lang.state) (lib : KVS_transaction_api) 13 | (U : User_params) (A : gset socket_address) (IPs : gset ip_address) : 14 | KVS_InvName = nroot .@ "kvs_inv" → 15 | state_heaps σ = {[ip:=∅]} → 16 | state_sockets σ = {[ip:=∅]} → 17 | state_ms σ = ∅ → 18 | state_trace σ = [] → 19 | ip ∉ IPs → 20 | (∀ `{anerisG Σ}, ⊢ |={⊤}=> RU_spec A lib) → 21 | (∀ `{anerisG Σ}, ⊢ 22 | {{{ RU_spec A (KVS_wrapped_api lib) 23 | ∗ unallocated A ∗ ([∗ set] a ∈ A, a ⤳ (∅, ∅)) ∗ ([∗ set] ip ∈ IPs, free_ip ip) }}} 24 | e @[ip] 25 | {{{ v, RET v; True }}}) → 26 | ∀ σ' e', 27 | rtc step ([(mkExpr ip e)], σ) (e', σ') → 28 | valid_trace_ru (state_trace σ'). 29 | Proof. 30 | intros. 31 | eapply adequacy_trace; try done; first apply valid_trace_ru_empty. 32 | iIntros (Ag) "(Htr & #Hinv)". 33 | iMod H6 as "Hspec". 34 | iMod (implication_trace.library_implication with "[$Htr $Hspec $Hinv]") 35 | as "Hspec"; last done. 36 | by iPureIntro. 37 | Qed. -------------------------------------------------------------------------------- /aneris/examples/transactional_consistency/snapshot_isolation/examples/bank_transfer/bank_transfer_code.v: -------------------------------------------------------------------------------- 1 | (* This file is automatically generated from the OCaml source file 2 | /ml_sources/examples/transactional_consistency/snapshot_isolation/examples/bank_transfer/bank_transfer_code.ml *) 3 | 4 | From aneris.aneris_lang Require Import ast. 5 | From aneris.aneris_lang.lib.serialization Require Import serialization_code. 6 | From aneris.examples.transactional_consistency.snapshot_isolation Require Import snapshot_isolation_code. 7 | From aneris.examples.transactional_consistency.snapshot_isolation.util Require Import util_code. 8 | 9 | Definition transaction : val := 10 | λ: "cst" "amount" "src" "dst", 11 | start "cst";; 12 | let: "vsrc" := unSOME (read "cst" "src") in 13 | (if: "amount" ≤ "vsrc" 14 | then 15 | write "cst" "src" ("vsrc" - "amount");; 16 | let: "vdst" := unSOME (read "cst" "dst") in 17 | write "cst" "dst" ("vdst" + "amount") 18 | else #());; 19 | commitU "cst". 20 | -------------------------------------------------------------------------------- /aneris/examples/transactional_consistency/snapshot_isolation/examples/causality_example/causality_example_code.v: -------------------------------------------------------------------------------- 1 | (* This file is automatically generated from the OCaml source file 2 | /ml_sources/examples/transactional_consistency/snapshot_isolation/examples/causality_example/causality_example_code.ml *) 3 | 4 | From aneris.aneris_lang Require Import ast. 5 | From aneris.aneris_lang.lib.serialization Require Import serialization_code. 6 | From aneris.examples.transactional_consistency.snapshot_isolation Require Import snapshot_isolation_code. 7 | From aneris.examples.transactional_consistency.snapshot_isolation.util Require Import util_code. 8 | 9 | Definition transaction1 : val := 10 | λ: "cst", start "cst";; 11 | write "cst" #"x" #1;; 12 | commitU "cst". 13 | 14 | Definition transaction2 : val := 15 | λ: "cst", 16 | wait_transaction "cst" (λ: "v", "v" = #1) #"x";; 17 | start "cst";; 18 | write "cst" #"y" #1;; 19 | commitU "cst". 20 | 21 | Definition transaction3 : val := 22 | λ: "cst", 23 | wait_transaction "cst" (λ: "v", "v" = #1) #"y";; 24 | start "cst";; 25 | let: "vx" := read "cst" #"x" in 26 | assert: ("vx" = (SOME #1));; 27 | commitU "cst". 28 | 29 | Definition transaction1_client : val := 30 | λ: "caddr" "kvs_addr", 31 | let: "cst" := init_client_proxy int_serializer "caddr" "kvs_addr" in 32 | transaction1 "cst". 33 | 34 | Definition transaction2_client : val := 35 | λ: "caddr" "kvs_addr", 36 | let: "cst" := init_client_proxy int_serializer "caddr" "kvs_addr" in 37 | transaction2 "cst". 38 | 39 | Definition transaction3_client : val := 40 | λ: "caddr" "kvs_addr", 41 | let: "cst" := init_client_proxy int_serializer "caddr" "kvs_addr" in 42 | transaction3 "cst". 43 | 44 | Definition server : val := λ: "srv", init_server int_serializer "srv". 45 | -------------------------------------------------------------------------------- /aneris/examples/transactional_consistency/snapshot_isolation/examples/classical_example/classical_example_code.v: -------------------------------------------------------------------------------- 1 | (* This file is automatically generated from the OCaml source file 2 | /ml_sources/examples/transactional_consistency/snapshot_isolation/examples/classical_example/classical_example_code.ml *) 3 | 4 | From aneris.aneris_lang Require Import ast. 5 | From aneris.aneris_lang.lib.serialization Require Import serialization_code. 6 | From aneris.examples.transactional_consistency.snapshot_isolation Require Import snapshot_isolation_code. 7 | From aneris.examples.transactional_consistency.snapshot_isolation.util Require Import util_code. 8 | 9 | Definition transaction1 : val := 10 | λ: "cst", 11 | start "cst";; 12 | write "cst" #"x" #1;; 13 | write "cst" #"y" #1;; 14 | commitU "cst". 15 | 16 | Definition transaction2 : val := 17 | λ: "cst", 18 | start "cst";; 19 | write "cst" #"x" #2;; 20 | write "cst" #"y" #2;; 21 | commitU "cst". 22 | 23 | Definition transaction3 : val := 24 | λ: "cst", 25 | start "cst";; 26 | let: "vx" := read "cst" #"x" in 27 | let: "vy" := read "cst" #"y" in 28 | assert: ("vx" = "vy");; 29 | commitU "cst". 30 | 31 | Definition transaction1_client : val := 32 | λ: "caddr" "kvs_addr", 33 | let: "cst" := init_client_proxy int_serializer "caddr" "kvs_addr" in 34 | transaction1 "cst". 35 | 36 | Definition transaction2_client : val := 37 | λ: "caddr" "kvs_addr", 38 | let: "cst" := init_client_proxy int_serializer "caddr" "kvs_addr" in 39 | transaction2 "cst". 40 | 41 | Definition transaction3_client : val := 42 | λ: "caddr" "kvs_addr", 43 | let: "cst" := init_client_proxy int_serializer "caddr" "kvs_addr" in 44 | transaction3 "cst". 45 | 46 | Definition server : val := λ: "srv", init_server int_serializer "srv". 47 | -------------------------------------------------------------------------------- /aneris/examples/transactional_consistency/snapshot_isolation/examples/deprecated/anomalie/anomalie_code.v: -------------------------------------------------------------------------------- 1 | (* This file is automatically generated from the OCaml source file 2 | /ml_sources/examples/transactional_consistency/snapshot_isolation/examples/deprecated/anomalie/anomalie_code.ml *) 3 | 4 | 5 | 6 | 7 | -------------------------------------------------------------------------------- /aneris/examples/transactional_consistency/snapshot_isolation/examples/deprecated/classical_example_run/classical_example_run_code.v: -------------------------------------------------------------------------------- 1 | (* This file is automatically generated from the OCaml source file 2 | /ml_sources/examples/transactional_consistency/snapshot_isolation/examples/deprecated/classical_example_run/classical_example_run_code.ml *) 3 | 4 | From aneris.aneris_lang Require Import ast. 5 | From aneris.aneris_lang.lib.serialization Require Import serialization_code. 6 | From aneris.examples.transactional_consistency.snapshot_isolation Require Import snapshot_isolation_code. 7 | From aneris.examples.transactional_consistency.snapshot_isolation.util Require Import util_code. 8 | 9 | Definition transaction1 : val := 10 | λ: "cst", write "cst" #"x" #1;; 11 | write "cst" #"y" #1. 12 | 13 | Definition transaction2 : val := 14 | λ: "cst", write "cst" #"x" #2;; 15 | write "cst" #"y" #2. 16 | 17 | Definition transaction3 : val := 18 | λ: "cst", 19 | let: "vx" := read "cst" #"x" in 20 | let: "vy" := read "cst" #"y" in 21 | assert: ("vx" = "vy"). 22 | 23 | Definition transaction1_client : val := 24 | λ: "caddr" "kvs_addr", 25 | let: "cst" := init_client_proxy int_serializer "caddr" "kvs_addr" in 26 | run "cst" transaction1. 27 | 28 | Definition transaction2_client : val := 29 | λ: "caddr" "kvs_addr", 30 | let: "cst" := init_client_proxy int_serializer "caddr" "kvs_addr" in 31 | run "cst" transaction2. 32 | 33 | Definition transaction3_client : val := 34 | λ: "caddr" "kvs_addr", 35 | let: "cst" := init_client_proxy int_serializer "caddr" "kvs_addr" in 36 | run "cst" transaction3. 37 | 38 | Definition server : val := λ: "srv", init_server int_serializer "srv". 39 | -------------------------------------------------------------------------------- /aneris/examples/transactional_consistency/snapshot_isolation/examples/deprecated/disjoint_reads/disjoint_reads_code.v: -------------------------------------------------------------------------------- 1 | (* This file is automatically generated from the OCaml source file 2 | /ml_sources/examples/transactional_consistency/snapshot_isolation/examples/deprecated/disjoint_reads/disjoint_reads_code.ml *) 3 | 4 | From aneris.aneris_lang Require Import ast. 5 | From aneris.aneris_lang.lib.serialization Require Import serialization_code. 6 | From aneris.examples.transactional_consistency.snapshot_isolation Require Import snapshot_isolation_code. 7 | From aneris.examples.transactional_consistency.snapshot_isolation.util Require Import util_code. 8 | 9 | Definition transaction1 : val := 10 | λ: "cst", start "cst";; 11 | write "cst" #"x" #1;; 12 | commitT "cst". 13 | 14 | Definition transaction2 : val := 15 | λ: "cst", start "cst";; 16 | write "cst" #"y" #2;; 17 | commitT "cst". 18 | 19 | Definition transaction3 : val := 20 | λ: "cst", 21 | start "cst";; 22 | let: "vx" := read "cst" #"x" in 23 | let: "vy" := read "cst" #"y" in 24 | commitT "cst". 25 | 26 | Definition transaction1_client : val := 27 | λ: "caddr" "kvs_addr", 28 | let: "cst" := init_client_proxy int_serializer "caddr" "kvs_addr" in 29 | transaction1 "cst". 30 | 31 | Definition transaction2_client : val := 32 | λ: "caddr" "kvs_addr", 33 | let: "cst" := init_client_proxy int_serializer "caddr" "kvs_addr" in 34 | transaction2 "cst". 35 | 36 | Definition transaction3_client : val := 37 | λ: "caddr" "kvs_addr", 38 | let: "cst" := init_client_proxy int_serializer "caddr" "kvs_addr" in 39 | transaction3 "cst". 40 | 41 | Definition server : val := λ: "srv", init_server int_serializer "srv". 42 | -------------------------------------------------------------------------------- /aneris/examples/transactional_consistency/snapshot_isolation/examples/deprecated/read_your_writes/read_your_writes_code.v: -------------------------------------------------------------------------------- 1 | (* This file is automatically generated from the OCaml source file 2 | /ml_sources/examples/transactional_consistency/snapshot_isolation/examples/deprecated/read_your_writes/read_your_writes_code.ml *) 3 | 4 | From aneris.aneris_lang Require Import ast. 5 | From aneris.aneris_lang.lib.serialization Require Import serialization_code. 6 | From aneris.examples.transactional_consistency.snapshot_isolation Require Import snapshot_isolation_code. 7 | From aneris.examples.transactional_consistency.snapshot_isolation.util Require Import util_code. 8 | 9 | Definition transaction : val := 10 | λ: "cst", 11 | start "cst";; 12 | write "cst" #"x" #1;; 13 | let: "vx" := read "cst" #"x" in 14 | assert: ("vx" = (SOME #1));; 15 | commitU "cst". 16 | 17 | Definition transaction_client : val := 18 | λ: "caddr" "kvs_addr", 19 | let: "cst" := init_client_proxy int_serializer "caddr" "kvs_addr" in 20 | transaction "cst". 21 | 22 | Definition server : val := λ: "srv", init_server int_serializer "srv". 23 | -------------------------------------------------------------------------------- /aneris/examples/transactional_consistency/snapshot_isolation/examples/disjoint_writes/disjoint_writes_code.v: -------------------------------------------------------------------------------- 1 | (* This file is automatically generated from the OCaml source file 2 | /ml_sources/examples/transactional_consistency/snapshot_isolation/examples/disjoint_writes/disjoint_writes_code.ml *) 3 | 4 | From aneris.aneris_lang Require Import ast. 5 | From aneris.aneris_lang.lib.serialization Require Import serialization_code. 6 | From aneris.examples.transactional_consistency.snapshot_isolation Require Import snapshot_isolation_code. 7 | From aneris.examples.transactional_consistency.snapshot_isolation.util Require Import util_code. 8 | 9 | Definition transaction1 : val := 10 | λ: "cst", start "cst";; 11 | write "cst" #"x" #1;; 12 | commitT "cst". 13 | 14 | Definition transaction2 : val := 15 | λ: "cst", start "cst";; 16 | write "cst" #"y" #1;; 17 | commitT "cst". 18 | 19 | Definition transaction1_client : val := 20 | λ: "caddr" "kvs_addr", 21 | let: "cst" := init_client_proxy int_serializer "caddr" "kvs_addr" in 22 | transaction1 "cst". 23 | 24 | Definition transaction2_client : val := 25 | λ: "caddr" "kvs_addr", 26 | let: "cst" := init_client_proxy int_serializer "caddr" "kvs_addr" in 27 | transaction2 "cst". 28 | 29 | Definition server : val := λ: "srv", init_server int_serializer "srv". 30 | -------------------------------------------------------------------------------- /aneris/examples/transactional_consistency/snapshot_isolation/examples/function_call/function_call_code.v: -------------------------------------------------------------------------------- 1 | (* This file is automatically generated from the OCaml source file 2 | /ml_sources/examples/transactional_consistency/snapshot_isolation/examples/function_call/function_call_code.ml *) 3 | 4 | From aneris.aneris_lang Require Import ast. 5 | From aneris.aneris_lang.lib.serialization Require Import serialization_code. 6 | From aneris.examples.transactional_consistency.snapshot_isolation Require Import snapshot_isolation_code. 7 | From aneris.examples.transactional_consistency.snapshot_isolation.util Require Import util_code. 8 | 9 | Definition transaction1 : val := 10 | λ: "cst", start "cst";; 11 | write "cst" #"x" #42;; 12 | commitU "cst". 13 | 14 | Definition transaction2 : val := 15 | λ: "cst" "f", 16 | start "cst";; 17 | let: "r" := "f" "cst" #"x" in 18 | write "cst" #"y" "r";; 19 | commitU "cst". 20 | 21 | Definition transaction1_client : val := 22 | λ: "caddr" "kvs_addr", 23 | let: "cst" := init_client_proxy int_serializer "caddr" "kvs_addr" in 24 | transaction1 "cst". 25 | 26 | Definition transaction2_client : val := 27 | λ: "caddr" "kvs_addr" "f", 28 | let: "cst" := init_client_proxy int_serializer "caddr" "kvs_addr" in 29 | transaction2 "cst" "f". 30 | 31 | Definition server : val := λ: "srv", init_server int_serializer "srv". 32 | -------------------------------------------------------------------------------- /aneris/examples/transactional_consistency/snapshot_isolation/examples/non_repeatable_read/non_repeatable_read_code.v: -------------------------------------------------------------------------------- 1 | (* This file is automatically generated from the OCaml source file 2 | /ml_sources/examples/transactional_consistency/snapshot_isolation/examples/non_repeatable_read/non_repeatable_read_code.ml *) 3 | 4 | From aneris.aneris_lang Require Import ast. 5 | From aneris.aneris_lang.lib.serialization Require Import serialization_code. 6 | From aneris.examples.transactional_consistency.snapshot_isolation Require Import snapshot_isolation_code. 7 | From aneris.examples.transactional_consistency.snapshot_isolation.util Require Import util_code. 8 | 9 | Definition transaction1 : val := 10 | λ: "cst", start "cst";; 11 | write "cst" #"x" #1;; 12 | commitT "cst". 13 | 14 | Definition transaction2 : val := 15 | λ: "cst", 16 | start "cst";; 17 | let: "v1" := read "cst" #"x" in 18 | let: "v2" := read "cst" #"x" in 19 | assert: ("v1" = "v2");; 20 | commitT "cst". 21 | 22 | Definition transaction1_client : val := 23 | λ: "caddr" "kvs_addr", 24 | let: "cst" := init_client_proxy int_serializer "caddr" "kvs_addr" in 25 | transaction1 "cst". 26 | 27 | Definition transaction2_client : val := 28 | λ: "caddr" "kvs_addr", 29 | let: "cst" := init_client_proxy int_serializer "caddr" "kvs_addr" in 30 | transaction2 "cst". 31 | 32 | Definition server : val := λ: "srv", init_server int_serializer "srv". 33 | -------------------------------------------------------------------------------- /aneris/examples/transactional_consistency/snapshot_isolation/examples/only_reads/only_reads_code.v: -------------------------------------------------------------------------------- 1 | (* This file is automatically generated from the OCaml source file 2 | /ml_sources/examples/transactional_consistency/snapshot_isolation/examples/only_reads/only_reads_code.ml *) 3 | 4 | From aneris.aneris_lang Require Import ast. 5 | From aneris.aneris_lang.lib.serialization Require Import serialization_code. 6 | From aneris.examples.transactional_consistency.snapshot_isolation Require Import snapshot_isolation_code. 7 | From aneris.examples.transactional_consistency.snapshot_isolation.util Require Import util_code. 8 | 9 | Definition transaction1 : val := 10 | λ: "cst", start "cst";; 11 | write "cst" #"x" #1;; 12 | commitU "cst". 13 | 14 | Definition transaction2 : val := 15 | λ: "cst", start "cst";; 16 | let: "_vx" := read "cst" #"x" in 17 | commitT "cst". 18 | 19 | Definition transaction1_client : val := 20 | λ: "caddr" "kvs_addr", 21 | let: "cst" := init_client_proxy int_serializer "caddr" "kvs_addr" in 22 | transaction1 "cst". 23 | 24 | Definition transaction2_client : val := 25 | λ: "caddr" "kvs_addr", 26 | let: "cst" := init_client_proxy int_serializer "caddr" "kvs_addr" in 27 | transaction2 "cst". 28 | 29 | Definition server : val := λ: "srv", init_server int_serializer "srv". 30 | -------------------------------------------------------------------------------- /aneris/examples/transactional_consistency/snapshot_isolation/examples/proof_resources.v: -------------------------------------------------------------------------------- 1 | From aneris.aneris_lang Require Import proofmode. 2 | From aneris.examples.transactional_consistency Require Import resource_algebras. 3 | From iris.algebra Require Import excl. 4 | 5 | Section resources. 6 | 7 | Context `{!anerisG Mdl Σ, !KVSG Σ}. 8 | 9 | Definition token (γ : gname) : iProp Σ := own γ (Excl ()). 10 | 11 | Lemma token_exclusive (γ : gname) : token γ -∗ token γ -∗ False. 12 | Proof. iIntros "H1 H2". by iDestruct (own_valid_2 with "H1 H2") as %?. Qed. 13 | 14 | End resources. 15 | -------------------------------------------------------------------------------- /aneris/examples/transactional_consistency/snapshot_isolation/examples/read_skew/read_skew_code.v: -------------------------------------------------------------------------------- 1 | (* This file is automatically generated from the OCaml source file 2 | /ml_sources/examples/transactional_consistency/snapshot_isolation/examples/read_skew/read_skew_code.ml *) 3 | 4 | From aneris.aneris_lang Require Import ast. 5 | From aneris.aneris_lang.lib.serialization Require Import serialization_code. 6 | From aneris.examples.transactional_consistency.snapshot_isolation Require Import snapshot_isolation_code. 7 | From aneris.examples.transactional_consistency.snapshot_isolation.util Require Import util_code. 8 | 9 | Definition transaction1 : val := 10 | λ: "cst", 11 | start "cst";; 12 | write "cst" #"x" #1;; 13 | write "cst" #"y" #1;; 14 | commitT "cst". 15 | 16 | Definition transaction2 : val := 17 | λ: "cst", 18 | start "cst";; 19 | let: "vx" := read "cst" #"x" in 20 | let: "vy" := read "cst" #"y" in 21 | assert: ("vx" = "vy");; 22 | commitT "cst". 23 | 24 | Definition transaction1_client : val := 25 | λ: "caddr" "kvs_addr", 26 | let: "cst" := init_client_proxy int_serializer "caddr" "kvs_addr" in 27 | transaction1 "cst". 28 | 29 | Definition transaction2_client : val := 30 | λ: "caddr" "kvs_addr", 31 | let: "cst" := init_client_proxy int_serializer "caddr" "kvs_addr" in 32 | transaction2 "cst". 33 | 34 | Definition server : val := λ: "srv", init_server int_serializer "srv". 35 | -------------------------------------------------------------------------------- /aneris/examples/transactional_consistency/snapshot_isolation/examples/sequential_writes/sequential_writes_code.v: -------------------------------------------------------------------------------- 1 | (* This file is automatically generated from the OCaml source file 2 | /ml_sources/examples/transactional_consistency/snapshot_isolation/examples/sequential_writes/sequential_writes_code.ml *) 3 | 4 | From aneris.aneris_lang Require Import ast. 5 | From aneris.aneris_lang.lib.serialization Require Import serialization_code. 6 | From aneris.examples.transactional_consistency.snapshot_isolation Require Import snapshot_isolation_code. 7 | From aneris.examples.transactional_consistency.snapshot_isolation.util Require Import util_code. 8 | 9 | Definition transaction1 : val := 10 | λ: "cst", start "cst";; 11 | write "cst" #"x" #1;; 12 | commitT "cst". 13 | 14 | Definition transaction2 : val := 15 | λ: "cst", 16 | wait_transaction "cst" (λ: "v", "v" = #1) #"x";; 17 | start "cst";; 18 | write "cst" #"x" #2;; 19 | commitT "cst". 20 | 21 | Definition transaction1_client : val := 22 | λ: "caddr" "kvs_addr", 23 | let: "cst" := init_client_proxy int_serializer "caddr" "kvs_addr" in 24 | transaction1 "cst". 25 | 26 | Definition transaction2_client : val := 27 | λ: "caddr" "kvs_addr", 28 | let: "cst" := init_client_proxy int_serializer "caddr" "kvs_addr" in 29 | transaction2 "cst". 30 | 31 | Definition server : val := λ: "srv", init_server int_serializer "srv". 32 | -------------------------------------------------------------------------------- /aneris/examples/transactional_consistency/snapshot_isolation/examples/write_skew/write_skew_code.v: -------------------------------------------------------------------------------- 1 | (* This file is automatically generated from the OCaml source file 2 | /ml_sources/examples/transactional_consistency/snapshot_isolation/examples/write_skew/write_skew_code.ml *) 3 | 4 | From aneris.aneris_lang Require Import ast. 5 | From aneris.aneris_lang.lib.serialization Require Import serialization_code. 6 | From aneris.examples.transactional_consistency.snapshot_isolation Require Import snapshot_isolation_code. 7 | From aneris.examples.transactional_consistency.snapshot_isolation.util Require Import util_code. 8 | 9 | Definition transaction1 : val := 10 | λ: "cst", 11 | start "cst";; 12 | let: "vy" := read "cst" #"y" in 13 | write "cst" #"x" #1;; 14 | commitT "cst". 15 | 16 | Definition transaction2 : val := 17 | λ: "cst", 18 | start "cst";; 19 | let: "vx" := read "cst" #"x" in 20 | write "cst" #"y" #1;; 21 | commitT "cst". 22 | 23 | Definition transaction1_client : val := 24 | λ: "caddr" "kvs_addr", 25 | let: "cst" := init_client_proxy int_serializer "caddr" "kvs_addr" in 26 | transaction1 "cst". 27 | 28 | Definition transaction2_client : val := 29 | λ: "caddr" "kvs_addr", 30 | let: "cst" := init_client_proxy int_serializer "caddr" "kvs_addr" in 31 | transaction2 "cst". 32 | 33 | Definition server : val := λ: "srv", init_server int_serializer "srv". 34 | -------------------------------------------------------------------------------- /aneris/examples/transactional_consistency/snapshot_isolation/instantiation/snapshot_isolation_api_implementation.v: -------------------------------------------------------------------------------- 1 | From aneris.examples.transactional_consistency.snapshot_isolation 2 | Require Import snapshot_isolation_code. 3 | From aneris.examples.transactional_consistency 4 | Require Import code_api. 5 | From aneris.aneris_lang Require Import resources. 6 | From aneris.examples.transactional_consistency Require Import user_params. 7 | 8 | 9 | Global Instance KVS_snapshot_isolation_api_implementation : 10 | KVS_transaction_api := 11 | {| 12 | TC_init_server := init_server; 13 | TC_start := start; 14 | TC_read := read; 15 | TC_write := write; 16 | TC_commit := commit; 17 | TC_init_client_proxy := init_client_proxy; 18 | |}. 19 | -------------------------------------------------------------------------------- /aneris/examples/transactional_consistency/snapshot_isolation/specs/aux_defs.v: -------------------------------------------------------------------------------- 1 | From iris.algebra Require Import auth gmap excl excl_auth. 2 | From aneris.algebra Require Import monotone. 3 | From aneris.aneris_lang Require Import network resources proofmode. 4 | From aneris.aneris_lang.lib Require Import 5 | list_proof inject lock_proof. 6 | From aneris.aneris_lang.lib.serialization 7 | Require Import serialization_proof. 8 | From aneris.aneris_lang.program_logic Require Import lightweight_atomic. 9 | From aneris.examples.transactional_consistency 10 | Require Import code_api user_params. 11 | 12 | Definition Hist : Set := list val. 13 | 14 | Inductive local_state : Type := 15 | | CanStart 16 | | Active (ms : gmap Key Hist). 17 | 18 | Definition can_commit `{User_params} 19 | (m ms : gmap Key Hist) (mc : gmap Key (option val * bool)) : bool := 20 | bool_decide (∀ (k : Key), k ∈ KVS_keys → 21 | match (mc !! k : option (option val * bool)) with 22 | | Some (vo, true) => bool_decide (m !! k = ms !! k) 23 | | _ => true 24 | end). 25 | 26 | Definition commit_event 27 | (p : option val * bool) (h : Hist) := 28 | match p with 29 | | (Some v, true) => h ++ [v] 30 | | _ => h 31 | end. 32 | -------------------------------------------------------------------------------- /aneris/examples/transactional_consistency/snapshot_isolation/specs/time.v: -------------------------------------------------------------------------------- 1 | From stdpp Require Import gmap. 2 | 3 | (** Abstract Notion of Timestamps with Total Order. *) 4 | 5 | Section Time. 6 | 7 | 8 | Class KVS_time := { 9 | Time : Type; 10 | TM_lt : relation Time; 11 | TM_lt_TO :> StrictOrder TM_lt; 12 | TM_lt_tricho : ∀ m n : Time, TM_lt m n ∨ m = n ∨ TM_lt n m; 13 | TM_EqDecision :> EqDecision Time; 14 | TM_Countable :> Countable Time; 15 | }. 16 | 17 | 18 | End Time. 19 | -------------------------------------------------------------------------------- /aneris/examples/transactional_consistency/snapshot_isolation/trace/adequacy_trace.v: -------------------------------------------------------------------------------- 1 | From aneris.examples.transactional_consistency.snapshot_isolation.specs Require Import specs resources. 2 | From aneris.examples.transactional_consistency Require Import state_based_model. 3 | From trillium.prelude Require Import classical_instances. 4 | From trillium.program_logic Require Import language. 5 | From trillium Require Import finitary. 6 | From aneris.aneris_lang Require Import adequacy aneris_lang proofmode adequacy_no_model adequacy_trace. 7 | From iris.base_logic.lib Require Import invariants. 8 | From aneris.examples.transactional_consistency Require Import resource_algebras code_api wrapped_library user_params. 9 | From aneris.examples.transactional_consistency.snapshot_isolation.trace Require implication_trace. 10 | 11 | Theorem adequacy_trace_si Σ `{anerisPreG Σ unit_model, KVSG Σ} ip 12 | (e : expr) (σ : aneris_lang.state) (lib : KVS_transaction_api) 13 | (U : User_params) (A : gset socket_address) (IPs : gset ip_address) : 14 | KVS_InvName = nroot .@ "kvs_inv" → 15 | state_heaps σ = {[ip:=∅]} → 16 | state_sockets σ = {[ip:=∅]} → 17 | state_ms σ = ∅ → 18 | state_trace σ = [] → 19 | ip ∉ IPs → 20 | (∀ `{anerisG Σ}, ⊢ |={⊤}=> SI_spec A lib) → 21 | (∀ `{anerisG Σ}, ⊢ 22 | {{{ SI_spec A (KVS_wrapped_api lib) 23 | ∗ unallocated A ∗ ([∗ set] a ∈ A, a ⤳ (∅, ∅)) ∗ ([∗ set] ip ∈ IPs, free_ip ip) }}} 24 | e @[ip] 25 | {{{ v, RET v; True }}}) → 26 | ∀ σ' e', 27 | rtc step ([(mkExpr ip e)], σ) (e', σ') → 28 | valid_trace_si (state_trace σ'). 29 | Proof. 30 | intros. 31 | eapply adequacy_trace; try done; first apply valid_trace_si_empty. 32 | iIntros (Ag) "(Htr & #Hinv)". 33 | iMod H6 as "Hspec". 34 | iMod (implication_trace.library_implication with "[$Htr $Hspec $Hinv]") 35 | as "Hspec"; last done. 36 | by iPureIntro. 37 | Qed. -------------------------------------------------------------------------------- /aneris/examples/transactional_consistency/snapshot_isolation/wrapped_snapshot_isolation_code.v: -------------------------------------------------------------------------------- 1 | From aneris.aneris_lang Require Import ast. 2 | From aneris.examples.transactional_consistency.snapshot_isolation Require Import snapshot_isolation_code. 3 | From aneris.examples.transactional_consistency Require Import wrapped_library. 4 | 5 | Definition start : val := wrap_start start. 6 | 7 | Definition read : val := wrap_read read. 8 | 9 | Definition write : val := wrap_write write. 10 | 11 | Definition commit : val := wrap_commit commit. 12 | 13 | Definition init_server ser : val := init_server ser. 14 | 15 | Definition init_client_proxy ser : val := wrap_init_client_proxy init_client_proxy ser. -------------------------------------------------------------------------------- /aneris/examples/transactional_consistency/user_params.v: -------------------------------------------------------------------------------- 1 | From RecordUpdate Require Import RecordSet. 2 | From aneris.aneris_lang Require Import network resources. 3 | From aneris.aneris_lang.lib.serialization Require Import serialization_proof. 4 | From aneris.examples.reliable_communication.prelude Require Import ser_inj. 5 | 6 | Definition Key := string. 7 | 8 | (** Arguments that user supplies to the interface *) 9 | 10 | Class User_params := { 11 | KVS_address : socket_address; 12 | KVS_keys : gset Key; 13 | KVS_InvName : namespace; 14 | KVS_serialization : serialization; 15 | KVS_ser_inj : ser_is_injective KVS_serialization; 16 | KVS_ser_inj_alt : ser_is_injective_alt KVS_serialization 17 | }. 18 | 19 | Notation KVS_Serializable v := (Serializable KVS_serialization v). 20 | 21 | Record SerializableVal `{!User_params} := 22 | SerVal {SV_val : val; 23 | SV_ser : KVS_Serializable SV_val }. 24 | 25 | Coercion SV_val : SerializableVal >-> val. 26 | 27 | Existing Instance SV_ser. 28 | 29 | Arguments SerVal {_} _ {_}. 30 | -------------------------------------------------------------------------------- /aneris/examples/viewstamped_replication/vr_debug.v: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/logsem/aneris/97fdc42e424875e30d31a3f6746e40eddf829ef7/aneris/examples/viewstamped_replication/vr_debug.v -------------------------------------------------------------------------------- /aneris/prelude/quorum.v: -------------------------------------------------------------------------------- 1 | Require Import Arith ZArith ZArith ZifyClasses ZifyInst Lia. 2 | From Coq.ssr Require Import ssreflect. 3 | From stdpp Require Import base gmap fin_sets. 4 | 5 | (* For the [lia] tactic to support [Nat.div]. *) 6 | Ltac Zify.zify_post_hook ::= Z.to_euclidean_division_equations. 7 | #[global] Program Instance Op_Nat_div : BinOp Nat.div := 8 | {| TBOp := Z.div ; TBOpInj := Nat2Z.inj_div |}. 9 | Add Zify BinOp Op_Nat_div. 10 | 11 | Record Quorum `{Countable A} (X : gset A) := quorum { 12 | quorum_car :> gset A → Prop; 13 | quorum_subseteq Q : quorum_car Q → Q ⊆ X; 14 | quorum_intersection_nonempty Q1 Q2 : 15 | quorum_car Q1 → quorum_car Q2 → Q1 ∩ Q2 ≠ ∅; 16 | }. 17 | Arguments quorum {_ _ _}. 18 | Arguments quorum_car : simpl never. 19 | Arguments quorum_subseteq {_ _ _ _}. 20 | Arguments quorum_intersection_nonempty {_ _ _ _}. 21 | 22 | Lemma quorum_choose `{Countable A, QuorumX : Quorum X} (Q1 Q2 : gset A) : 23 | QuorumX Q1 → QuorumX Q2 → ∃ a, a ∈ Q1 ∩ Q2. 24 | Proof. 25 | intros ??. by eapply set_choose_L, quorum_intersection_nonempty. 26 | Qed. 27 | 28 | Program Definition Quorum_majority `{Countable A} (X : gset A) : Quorum X := 29 | quorum _ (λ Q, size X / 2 < size Q ∧ Q ⊆ X) _ _. 30 | Next Obligation. by destruct 1. Qed. 31 | Next Obligation. 32 | intros ?????? [? ?] [? ?] ?. 33 | assert (size Q1 + size Q2 ≤ size X). 34 | { rewrite -size_union; [set_solver|]. 35 | by apply subseteq_size, union_subseteq. } 36 | lia. 37 | Qed. 38 | -------------------------------------------------------------------------------- /coq-aneris.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | name: "coq-aneris" 3 | synopsis: "Coq development of the Aneris program logic for verifying distributed systems" 4 | maintainer: "Aneris Team" 5 | authors: "Aneris Team" 6 | license: "MIT" 7 | homepage: "https://github.com/logsem/aneris" 8 | dev-repo: "git+https://github.com/logsem/aneris.git" 9 | bug-reports: "https://github.com/logsem/aneris/issues" 10 | build: [make "-j%{jobs}%"] 11 | install: [] 12 | depends: [ 13 | "coq" { (= "8.16.1") | (= "dev") } 14 | ] 15 | -------------------------------------------------------------------------------- /documentation.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/logsem/aneris/97fdc42e424875e30d31a3f6746e40eddf829ef7/documentation.pdf -------------------------------------------------------------------------------- /ml_sources/aneris_lang/README.md: -------------------------------------------------------------------------------- 1 | run `dune build` to compile ml_sources/ 2 | -------------------------------------------------------------------------------- /ml_sources/aneris_lang/dune: -------------------------------------------------------------------------------- 1 | (include_subdirs unqualified) 2 | 3 | (library 4 | (wrapped false) 5 | (name aneris) 6 | (flags :standard -rectypes) 7 | (libraries unix threads ocaml-compiler-libs.common domainslib)) -------------------------------------------------------------------------------- /ml_sources/aneris_lang/lib/bag_code.ml: -------------------------------------------------------------------------------- 1 | open! Ast 2 | 3 | let newbag () = 4 | let l = ref None in 5 | let v = newlock () in 6 | (l, v) 7 | 8 | let insert x e = 9 | let l = fst x in 10 | let lock = snd x in 11 | acquire lock; 12 | l := Some (e, !l); 13 | release lock 14 | 15 | let remove x = 16 | let l = fst x in 17 | let lock = snd x in 18 | acquire lock; 19 | let r = !l in 20 | let res = 21 | match r with 22 | None -> None 23 | | Some p -> l := snd p; Some (fst p) in 24 | release lock; 25 | res 26 | -------------------------------------------------------------------------------- /ml_sources/aneris_lang/lib/coin_flip_code.ml: -------------------------------------------------------------------------------- 1 | open! Ast 2 | 3 | let coin_flip () = 4 | let l = ref true in 5 | fork (fun () -> l := false) (); 6 | !l 7 | -------------------------------------------------------------------------------- /ml_sources/aneris_lang/lib/map_code.ml: -------------------------------------------------------------------------------- 1 | open! Ast 2 | open List_code 3 | open Set_code 4 | 5 | type ('a, 'b) amap = ('a * 'b) alist 6 | 7 | let map_empty () : ('a, 'b) amap = list_nil 8 | 9 | let map_remove (key : 'a) : ('a, 'b) amap -> ('a, 'b) amap = 10 | let rec loop (m : ('a, 'b) amap) = 11 | match m with 12 | None -> None 13 | | Some p -> 14 | if fst (fst p) = key 15 | then snd p 16 | else list_cons (fst p) (loop (snd p)) in 17 | loop 18 | 19 | let map_insert key value m : ('a, 'b) amap = 20 | list_cons (key, value) (map_remove key m) 21 | 22 | let map_lookup (key : 'a) : ('a, 'b) amap -> 'b option = 23 | let rec loop m = 24 | match m with 25 | None -> None 26 | | Some p -> if fst (fst p) = key 27 | then Some (snd (fst p)) 28 | else loop (snd p) 29 | in loop 30 | 31 | let map_mem (k : 'a) (m : ('a, 'b) amap) : bool = 32 | match map_lookup k m with 33 | None -> false 34 | | Some _p -> true 35 | 36 | let rec map_dom (m : ('a, 'b) amap) : 'a aset = 37 | match m with 38 | None -> set_empty () 39 | | Some p -> set_add (fst (fst p)) (map_dom (snd p)) 40 | 41 | let rec map_iter (f : 'a -> 'b -> 'c) (m : ('a, 'b) amap) : unit = 42 | match m with 43 | None -> () 44 | | Some p -> 45 | let entry = fst p in 46 | f (fst entry) (snd entry); 47 | map_iter f (snd p) 48 | 49 | let rec map_forall (f : 'a -> 'b -> bool) (m : ('a, 'b) amap) : bool = 50 | match m with 51 | None -> true 52 | | Some p -> 53 | let entry = fst p in 54 | let t = snd p in 55 | f (fst entry) (snd entry) && map_forall f t 56 | -------------------------------------------------------------------------------- /ml_sources/aneris_lang/lib/network_util_code.ml: -------------------------------------------------------------------------------- 1 | open Ast 2 | open List_code 3 | open Set_code 4 | 5 | let unSOME o = match o with 6 | None -> assert false 7 | | Some x -> x 8 | 9 | let sendto_all skt ns msg = 10 | list_iter (fun n -> ignore(sendTo skt msg n)) ns 11 | 12 | let rec listen skt handler = 13 | match receiveFrom skt with 14 | | Some m -> 15 | let msg = fst m in 16 | let sender = snd m in 17 | handler msg sender 18 | | None -> listen skt handler 19 | 20 | let wait_receivefrom skt test = 21 | let rec loop () = 22 | let msg = unSOME (receiveFrom skt) in 23 | if test msg then msg else loop () in 24 | loop () 25 | 26 | let wait_receivefresh skt ms = 27 | wait_receivefrom skt (fun m -> not (list_mem m ms)) 28 | 29 | let sendto_all_set = 30 | fun skt x msg -> 31 | set_iter (fun n -> let _l = sendTo skt msg n in ()) x 32 | 33 | let receivefrom_all = 34 | fun skt nodes -> 35 | let rec recv n = 36 | let msg = unSOME (receiveFrom skt) in 37 | let sender = snd msg in 38 | if sender = n then (fst msg) 39 | else recv n in 40 | list_fold (fun acc n -> list_append acc (list_cons (recv n) list_nil)) list_nil nodes 41 | 42 | let wait_receivefrom_all = 43 | fun skt nodes test -> 44 | let rec recv n = 45 | let msg = unSOME (receiveFrom skt) in 46 | let sender = snd msg in 47 | let m = fst msg in 48 | if (sender = n) && (test m) then m 49 | else recv n in 50 | list_fold (fun acc n -> list_append acc (list_cons (recv n) list_nil)) list_nil nodes 51 | 52 | let tag_of_message msg = 53 | match findFrom msg 0 '_' with 54 | Some i -> substring msg 0 i 55 | | None -> "UNDEFINED" 56 | 57 | let value_of_message msg = 58 | match findFrom msg 0 '_' with 59 | Some i -> let length = strlen msg in 60 | let start = i + 1 in 61 | substring msg start (length - start) 62 | | None -> "UNDEFINED" 63 | -------------------------------------------------------------------------------- /ml_sources/aneris_lang/lib/nodup_code.ml: -------------------------------------------------------------------------------- 1 | open Ast 2 | open List_code 3 | open Set_code 4 | open Map_code 5 | open Network_util_code 6 | 7 | 8 | let receivefrom_nodup rcvlog skt = 9 | let rec loop () = 10 | let msg = unSOME (receiveFrom skt) in 11 | if set_mem msg rcvlog then loop () 12 | else (msg, set_add msg rcvlog) in 13 | loop () 14 | 15 | let rec receivefrom_nodup_n skt msgs n = 16 | if n = 0 then (list_nil, msgs) else 17 | let tmp = receivefrom_nodup msgs skt in 18 | let m = fst tmp in 19 | let msgs' = snd tmp in 20 | let tailmsgs = receivefrom_nodup_n skt msgs' (n - 1) in 21 | let ms = fst tailmsgs in 22 | let msgs'' = snd tailmsgs in 23 | (list_cons m ms, msgs'') 24 | 25 | let nodup_empty = set_empty 26 | 27 | let nodup_init () = 28 | let log = ref (nodup_empty ()) in 29 | fun skt -> 30 | let tmp = receivefrom_nodup !log skt in 31 | let msg = fst tmp in 32 | let log' = snd tmp in 33 | log := log'; 34 | msg 35 | 36 | let receivefrom_nodup_set skt rcv addrs = 37 | let msgs = ref (map_empty ()) in 38 | let rec loop () = 39 | if set_equal (map_dom !msgs) addrs then !msgs 40 | else 41 | let msg = rcv skt in 42 | msgs := map_insert (snd msg) (fst msg) !msgs; 43 | loop () in 44 | loop () 45 | -------------------------------------------------------------------------------- /ml_sources/aneris_lang/lib/par_code.ml: -------------------------------------------------------------------------------- 1 | (* #rectypes;; *) 2 | 3 | open! Ast 4 | open Spawn_code 5 | 6 | 7 | let par e1 e2 = 8 | let handle = spawn e1 in 9 | let v2 = e2 () in 10 | let v1 = join handle in 11 | (v1, v2) 12 | 13 | [@@@NOTATION {|Notation "e1 ||| e2" := (par (λ: <>, e1)%E (λ: <>, e2)%E) : expr_scope.|}] 14 | [@@@NOTATION {|Notation "e1 ||| e2" := (par (λ: <>, e1)%V (λ: <>, e2)%V) : val_scope.|}] 15 | 16 | (* NB: use unix command to trigger non-determinism, e.g. 17 | 18 | let () = 19 | Printf.printf "---\n"; 20 | let (l,x,r) = (ref 0, ref false, ref 0) in 21 | for _i = 1 to 100 do 22 | let _ = par 23 | (fun () -> Unix.sleepf 0.0000000001; x := true; 24 | (* Printf.printf "%d %!" 0 *) 25 | ) 26 | (fun () -> Unix.sleepf 0.0000001; x := false; 27 | (* Printf.printf "%d %!" 1 *) 28 | ) in 29 | (* Printf.printf "---\n%!"; *) 30 | if !x then incr l 31 | else incr r 32 | done; 33 | Printf.printf "res : (%d, %d)%!" !l !r in () 34 | *) 35 | -------------------------------------------------------------------------------- /ml_sources/aneris_lang/lib/queue_code.ml: -------------------------------------------------------------------------------- 1 | open! Ast 2 | open List_code 3 | 4 | (* O(1) amortized functional queue. 5 | A queue is a pair `(front, back)`, where we pop from `front` 6 | and push to `back` (which is stored in reverse order). *) 7 | 8 | type 'a queue = 'a alist * 'a alist 9 | 10 | let queue_empty () = (list_nil, list_nil) 11 | 12 | let queue_is_empty q = 13 | match (fst q) with 14 | Some _p -> false 15 | | None -> 16 | match (snd q) with 17 | Some _p -> false 18 | | None -> true 19 | 20 | let queue_add e q = (fst q, list_cons e (snd q)) 21 | 22 | let queue_norm q = 23 | match (fst q) with 24 | Some _p -> q 25 | | None -> (list_rev (snd q), list_nil) 26 | 27 | let queue_peek_opt q = 28 | let q' = queue_norm q in 29 | match (fst q') with 30 | Some p -> Some (fst p) 31 | | None -> None 32 | 33 | let queue_take_opt q = 34 | let q' = queue_norm q in 35 | match (fst q') with 36 | Some p -> Some (fst p, (snd p, snd q')) 37 | | None -> None 38 | 39 | let queue_filter pred q = 40 | let (head, rev) = q in 41 | let all = list_append head (list_rev rev) in 42 | (list_filter pred all, None) 43 | 44 | let rec queue_drop q n = 45 | if n = 0 then q else 46 | let q' = queue_norm q in 47 | match fst q' with 48 | Some p -> queue_drop ((snd p, snd q')) (n - 1) 49 | | None -> q' 50 | 51 | let queue_iter f q = 52 | list_iter f (fst q); 53 | list_iter f (list_rev (snd q)) 54 | 55 | let queue_iteri f (q : 'a queue) = 56 | list_iteri f (fst q); 57 | list_iteri_loop f (list_length (fst q)) (list_rev (snd q)) 58 | -------------------------------------------------------------------------------- /ml_sources/aneris_lang/lib/set_code.ml: -------------------------------------------------------------------------------- 1 | open! Ast 2 | open List_code 3 | 4 | type 'a aset = 'a alist 5 | 6 | let set_empty () : 'a aset = list_nil 7 | 8 | let set_add : 'a -> 'a aset -> 'a aset = 9 | fun x s -> 10 | if list_mem x s then s 11 | else list_cons x s 12 | 13 | [@@@NOTATION {|Notation "{[ x ]}" := (set_add x (set_empty #())) (at level 1, format "{[ x ]}") : expr_scope.|}] 14 | 15 | [@@@NOTATION {|Notation "{[ x ; y ; .. ; z ]}" := 16 | (set_add x (set_add y .. (set_add z (set_empty #())) ..)) : expr_scope.|}] 17 | 18 | let set_mem : 'a -> 'a aset -> bool = list_mem 19 | 20 | let set_iter : ('a -> unit) -> 'a aset -> unit = list_iter 21 | 22 | let set_foldl : ('a -> 'b -> 'a) -> 'a -> 'b aset -> 'a = list_fold 23 | 24 | let set_forall : ('a -> bool) -> 'a aset -> bool = list_forall 25 | 26 | let set_cardinal : 'a aset -> int = list_length 27 | 28 | let set_subseteq : 'a aset -> 'a aset -> bool = 29 | fun x y -> list_forall (fun e -> set_mem e y) x 30 | 31 | let set_equal : 'a aset -> 'a aset -> bool = 32 | fun x y -> set_subseteq x y && set_subseteq y x 33 | -------------------------------------------------------------------------------- /ml_sources/aneris_lang/lib/spawn_code.ml: -------------------------------------------------------------------------------- 1 | open! Ast 2 | 3 | let spawn f = 4 | let c = ref None in 5 | fork (fun () -> c := Some (f ())) (); 6 | c 7 | 8 | let rec join c = 9 | match !c with 10 | | None -> join c 11 | | Some x -> x 12 | -------------------------------------------------------------------------------- /ml_sources/examples/ccddb/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name dune_code) 3 | (flags :standard -rectypes) 4 | (libraries aneris)) -------------------------------------------------------------------------------- /ml_sources/examples/consensus/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name paxos_runner) 3 | (flags :standard -rectypes) 4 | (libraries aneris)) -------------------------------------------------------------------------------- /ml_sources/examples/consensus/run.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | 4 | EXE="~/repositories/aneris/toolO2A/ocaml2lang/_build/default/test/aneris_examples/ml_sources/consensus/paxos_runner.exe" 5 | 6 | RUN () { 7 | osascript -e 'tell app "Terminal" to do script "'"${EXE//\"/\\\"} ${1//\"/\\\"}"'"' 8 | } 9 | 10 | RUN_PROPOSER () { 11 | osascript -e 'tell app "Terminal" to do script "'"${EXE//\"/\\\"} ${1//\"/\\\"} ${2//\"/\\\"}"'"' 12 | } 13 | 14 | 15 | RUN a1 16 | RUN a2 17 | RUN a3 18 | RUN_PROPOSER p1 13 19 | RUN_PROPOSER p2 42 20 | RUN c 21 | RUN l1 22 | RUN l2 23 | -------------------------------------------------------------------------------- /ml_sources/examples/crdt/oplib/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (wrapped false) 3 | (name oplib_code) 4 | (flags :standard -rectypes) 5 | (libraries aneris rcb_code)) 6 | -------------------------------------------------------------------------------- /ml_sources/examples/crdt/oplib/examples/add_wins_set/add_wins_set_code.ml: -------------------------------------------------------------------------------- 1 | open !Ast 2 | open List_code 3 | open Vector_clock_code 4 | open Serialization_code 5 | open Oplib_code 6 | 7 | (* Add-wins-set CRDT. If there are an add and a remove operation that are incomparable in time, the add operation wins. *) 8 | 9 | type 'valTy stTy = ('valTy * vector_clock) alist 10 | type 'valTy opTy = ('valTy, 'valTy) sumTy (* left is add, right is remove. *) 11 | 12 | 13 | let init_st () : 'valTy stTy = list_nil 14 | 15 | let effect (msg : 'valTy opTy msgTy) (st : 'valTy stTy) = 16 | let ((v, vc), _u) = msg in 17 | match v with 18 | | InjL w -> list_cons (w, vc) st 19 | | InjR w -> 20 | let should_keep p = 21 | if (fst p = w) then 22 | let vc' = snd p in 23 | not (vect_leq vc' vc) (* keep only if it was not added before *) 24 | else 25 | true 26 | in 27 | list_filter should_keep st 28 | 29 | let aws_crdt : ('valTy opTy, 'valTy stTy) crdtTy = fun () -> (init_st, effect) 30 | 31 | let aws_init (val_ser[@metavar]) (val_deser[@metavar]) addrs rid = 32 | let initRes = oplib_init (sum_ser val_ser val_ser) (sum_deser val_deser val_deser) addrs rid aws_crdt in 33 | let (get_state, update) = initRes in 34 | (get_state, update) 35 | -------------------------------------------------------------------------------- /ml_sources/examples/crdt/oplib/examples/add_wins_set/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name add_wins_set_code) 3 | (flags :standard -rectypes) 4 | (libraries oplib_code aneris)) 5 | -------------------------------------------------------------------------------- /ml_sources/examples/crdt/oplib/examples/gcounter/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name gcounter_code) 3 | (flags :standard -rectypes) 4 | (libraries oplib_code aneris)) 5 | -------------------------------------------------------------------------------- /ml_sources/examples/crdt/oplib/examples/gcounter/gcounter_code.ml: -------------------------------------------------------------------------------- 1 | open !Ast 2 | open Serialization_code 3 | open List_code 4 | open Oplib_code 5 | 6 | (* A positive-negative (PN) counter CRDT. 7 | A PN-Counter's state is just an integers. 8 | The counter can be incremented and decremented by 9 | an arbitrary amount. *) 10 | 11 | type opTy = int (* the delta (positive or negative) by which to modify the counter *) 12 | type stTy = int (* the state of the counter is its value *) 13 | 14 | let effect (msg : opTy msgTy) (counter : stTy) = 15 | let ((delta, _x), _y) = msg in 16 | assert (0 <= delta); 17 | counter + delta 18 | 19 | let init_st () = 0 20 | 21 | let counter_crdt : (opTy, stTy) crdtTy = fun () -> (init_st, effect) 22 | 23 | let counter_init (addrs : saddr alist) (rid : repIdTy) = 24 | let initRes = oplib_init int_ser int_deser addrs rid counter_crdt in 25 | let (get_state, update) = initRes in 26 | (get_state, update) 27 | -------------------------------------------------------------------------------- /ml_sources/examples/crdt/oplib/examples/grow_only_set/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name grow_only_set_code) 3 | (flags :standard -rectypes) 4 | (libraries oplib_code aneris)) 5 | -------------------------------------------------------------------------------- /ml_sources/examples/crdt/oplib/examples/grow_only_set/grow_only_set_code.ml: -------------------------------------------------------------------------------- 1 | open !Ast 2 | open Set_code 3 | open Oplib_code 4 | 5 | (* Grow only set CRDT. *) 6 | 7 | type 'valTy stTy = 'valTy aset 8 | type 'valTy opTy = Add of 'valTy 9 | 10 | 11 | let init_st () : 'valTy stTy = set_empty () 12 | 13 | let effect (msg : 'valTy opTy msgTy) (st : 'valTy stTy) = 14 | let ((v, _vc), _u) = msg in 15 | set_add v st 16 | 17 | let gos_crdt : ('valTy opTy, 'valTy stTy) crdtTy = fun () -> (init_st, effect) 18 | 19 | let gos_init (val_ser[@metavar]) (val_deser[@metavar]) addrs rid = 20 | let initRes = oplib_init val_ser val_deser addrs rid gos_crdt in 21 | let (get_state, update) = initRes in 22 | (get_state, update) 23 | -------------------------------------------------------------------------------- /ml_sources/examples/crdt/oplib/examples/lwwreg/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (wrapped false) 3 | (name lwwreg_code) 4 | (flags :standard -rectypes) 5 | (libraries oplib_code aneris)) 6 | -------------------------------------------------------------------------------- /ml_sources/examples/crdt/oplib/examples/map_comb/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name map_comb_code) 3 | (wrapped false) 4 | (flags :standard -rectypes) 5 | (libraries oplib_code aneris)) 6 | -------------------------------------------------------------------------------- /ml_sources/examples/crdt/oplib/examples/map_comb/map_comb_code.ml: -------------------------------------------------------------------------------- 1 | open !Ast 2 | open Serialization_code 3 | open Map_code 4 | open List_code 5 | open Oplib_code 6 | 7 | (* A map combinator, which takes a CRDT and maeks the CRDT of maps where keys are strings and values are of the type of the given CRDT. *) 8 | 9 | type 'a map_comb_opTy = string * 'a 10 | type 'a map_comb_stTy = (string, 'a) amap 11 | 12 | let map_comb_effect (init : unit -> 'a) (eff : ('a, 'b) effectFnTy) (msg : 'a map_comb_opTy msgTy) (state : 'b map_comb_stTy) = 13 | let (((key, delta), vc), origin) = msg in 14 | let cur_st_wo = 15 | match map_lookup key state with 16 | | None -> (init (), state) 17 | | Some cur -> (cur, map_remove key state) 18 | in 19 | let (current, state_without) = cur_st_wo in 20 | let newval = eff ((delta, vc), origin) current in 21 | map_insert key newval state_without 22 | 23 | let map_comb_init_st () = map_empty () 24 | 25 | let map_comb_crdt (crdt : ('a, 'b) crdtTy) : ('a map_comb_opTy, 'b map_comb_stTy) crdtTy = 26 | fun () -> 27 | let res = crdt () in 28 | let (is, eff) = res in 29 | (map_comb_init_st, map_comb_effect is eff) 30 | 31 | let map_comb_init (ser[@metavar "val"]) (deser[@metavar "val"]) crdt (addrs : saddr alist) (rid : repIdTy) = 32 | let initRes = oplib_init (prod_ser string_ser ser) (prod_deser string_ser deser) addrs rid (map_comb_crdt crdt) in 33 | let (get_state, update) = initRes in 34 | (get_state, update) 35 | -------------------------------------------------------------------------------- /ml_sources/examples/crdt/oplib/examples/mvreg/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name mvreg_code) 3 | (flags :standard -rectypes) 4 | (libraries oplib_code aneris)) -------------------------------------------------------------------------------- /ml_sources/examples/crdt/oplib/examples/mvreg/mvreg_code.ml: -------------------------------------------------------------------------------- 1 | open !Ast 2 | open Serialization_code 3 | open List_code 4 | open Vector_clock_code 5 | open Oplib_code 6 | 7 | (* Multi-value register. Concurrent writes are all kept. *) 8 | 9 | type 'valTy mvreg = ('valTy * vector_clock) alist 10 | type 'valTy writeOpTy = 'valTy (* `write v` *) 11 | 12 | (* let op_ser (val_ser[@metavar]) = val_ser *) 13 | 14 | (* let op_deser (val_deser[@metavar]) = val_deser *) 15 | 16 | let init_st (): 'valTy mvreg = list_nil 17 | 18 | let effect (msg : 'valTy writeOpTy msgTy) (reg : 'valTy mvreg) = 19 | let ((v, vc), _u) = msg in 20 | let vals = 21 | let is_conc = fun p -> 22 | let vc' = snd p in 23 | assert (not (vect_leq vc vc')); (* guaranteed by RCB and our locking *) 24 | vect_conc vc' vc (* keep all concurrent writes *) 25 | in 26 | list_filter is_conc reg 27 | in 28 | list_cons (v, vc) vals 29 | 30 | let mvreg_crdt : ('valTy writeOpTy, 'valTy mvreg) crdtTy = fun () -> (init_st, effect) 31 | 32 | let mvreg_init (* (val_ser[@metavar]) (val_deser[@metavar]) *) addrs rid = 33 | let initRes = oplib_init (* (op_ser val_ser) *) (* (op_deser val_deser) *) int_ser int_deser addrs rid mvreg_crdt in 34 | let (get_state, update) = initRes in 35 | (get_state, update) 36 | -------------------------------------------------------------------------------- /ml_sources/examples/crdt/oplib/examples/pncounter/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name pncounter_code) 3 | (flags :standard -rectypes) 4 | (libraries oplib_code aneris)) 5 | -------------------------------------------------------------------------------- /ml_sources/examples/crdt/oplib/examples/pncounter/pncounter_code.ml: -------------------------------------------------------------------------------- 1 | open !Ast 2 | open Serialization_code 3 | open List_code 4 | open Oplib_code 5 | 6 | (* A positive-negative (PN) counter CRDT. 7 | A PN-Counter's state is just an integers. 8 | The counter can be incremented and decremented by 9 | an arbitrary amount. *) 10 | 11 | type pncounter_opTy = int (* the delta (positive or negative) by which to modify the counter *) 12 | type pncounter_stTy = int (* the state of the counter is its value *) 13 | 14 | let pncounter_effect (msg : pncounter_opTy msgTy) (counter : pncounter_stTy) = 15 | let ((delta, _x), _y) = msg in 16 | counter + delta 17 | 18 | let pncounter_init_st () = 0 19 | 20 | let pncounter_crdt : (pncounter_opTy, pncounter_stTy) crdtTy = fun () -> (pncounter_init_st, pncounter_effect) 21 | 22 | let pncounter_init (addrs : saddr alist) (rid : repIdTy) = 23 | let initRes = oplib_init int_ser int_deser addrs rid pncounter_crdt in 24 | let (get_state, update) = initRes in 25 | (get_state, update) 26 | -------------------------------------------------------------------------------- /ml_sources/examples/crdt/oplib/examples/prod_comb/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name prod_comb) 3 | (flags :standard -rectypes) 4 | (libraries oplib_code aneris)) 5 | -------------------------------------------------------------------------------- /ml_sources/examples/crdt/oplib/examples/prod_comb/prod_comb_code.ml: -------------------------------------------------------------------------------- 1 | open !Ast 2 | open Serialization_code 3 | open List_code 4 | open Oplib_code 5 | 6 | (* A product combinator, which takes two CRDTs and maeks the CRDT of pairs of 7 | states of the CRDTs. *) 8 | 9 | type ('a, 'b) opTy = 'a * 'b 10 | type ('a, 'b) stTy = 'a * 'b 11 | 12 | let effect (eff1 : ('a, 'c) effectFnTy) (eff2 : ('b, 'd) effectFnTy) (msg : ('a, 'b) opTy msgTy) (state : ('c, 'd) stTy) = 13 | let (((delta1, delta2), vc), origin) = msg in 14 | let (st1, st2) = state in 15 | (eff1 ((delta1, vc), origin) st1, eff2 ((delta2, vc), origin) st2) 16 | 17 | let init_st is1 is2 () = (is1 (), is2 ()) 18 | 19 | let prod_comb_crdt (crdt1 : ('a, 'c) crdtTy) (crdt2 : ('b, 'd) crdtTy) : (('a, 'b) opTy, ('c, 'd) stTy) crdtTy = 20 | fun () -> 21 | let res1 = crdt1 () in 22 | let res2 = crdt2 () in 23 | let (is1, eff1) = res1 in 24 | let (is2, eff2) = res2 in 25 | (init_st is1 is2, effect eff1 eff2) 26 | 27 | let prod_comb_init (a_ser[@metavar "val"]) (a_deser[@metavar "val"]) (b_ser[@metavar "val"]) (b_deser[@metavar "val"]) crdt1 crdt2 (addrs : saddr alist) (rid : repIdTy) = 28 | let initRes = oplib_init (prod_ser a_ser b_ser) (prod_deser a_deser b_deser) addrs rid (prod_comb_crdt crdt1 crdt2) in 29 | let (get_state, update) = initRes in 30 | (get_state, update) 31 | -------------------------------------------------------------------------------- /ml_sources/examples/crdt/oplib/examples/remove_wins_set/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name remove_wins_set_code) 3 | (flags :standard -rectypes) 4 | (libraries oplib_code aneris)) 5 | -------------------------------------------------------------------------------- /ml_sources/examples/crdt/oplib/examples/table_of_counters/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name table_of_counters_code) 3 | (flags :standard -rectypes) 4 | (libraries oplib_code aneris map_comb_code pncounter_code)) 5 | -------------------------------------------------------------------------------- /ml_sources/examples/crdt/oplib/examples/table_of_counters/table_of_counters_code.ml: -------------------------------------------------------------------------------- 1 | open !Ast 2 | open Serialization_code 3 | open List_code 4 | open Oplib_code 5 | open Map_comb_code 6 | open Pncounter_code 7 | 8 | (* A table of positive-negative counters. *) 9 | 10 | type opTy = pncounter_opTy map_comb_opTy 11 | type stTy = pncounter_stTy map_comb_stTy 12 | 13 | let table_of_counters_effect (msg : opTy msgTy) (st : stTy) = map_comb_effect pncounter_init_st pncounter_effect msg st 14 | 15 | let table_of_counters_init_st () = map_comb_init_st () 16 | 17 | let table_of_counters_crdt : (opTy, stTy) crdtTy = fun () -> (table_of_counters_init_st, table_of_counters_effect) 18 | 19 | let table_of_counters_init (addrs : saddr alist) (rid : repIdTy) = 20 | let initRes = oplib_init (prod_ser string_ser int_ser) (prod_deser string_deser int_deser) addrs rid table_of_counters_crdt in 21 | let (get_state, update) = initRes in 22 | (get_state, update) 23 | -------------------------------------------------------------------------------- /ml_sources/examples/crdt/oplib/examples/table_of_lwwregs/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (wrapped false) 3 | (name table_of_lwwregs_code) 4 | (flags :standard -rectypes) 5 | (libraries oplib_code aneris map_comb_code lwwreg_code)) 6 | -------------------------------------------------------------------------------- /ml_sources/examples/crdt/oplib/examples/table_of_lwwregs/table_of_lwwregs_code.ml: -------------------------------------------------------------------------------- 1 | open !Ast 2 | open Serialization_code 3 | open List_code 4 | open Oplib_code 5 | open Map_comb_code 6 | open Lwwreg_code 7 | 8 | (* A table of multi valued registers. *) 9 | 10 | type 'valTy table_of_lwwregs_opTy = ('valTy writeOpTy) map_comb_opTy 11 | type 'valTy table_of_lwwregs_stTy = ('valTy lwwreg) map_comb_stTy 12 | 13 | let table_of_lwwregs_effect (msg : ('valTy table_of_lwwregs_opTy) msgTy) (st : 'valTy table_of_lwwregs_stTy) = map_comb_effect lwwreg_init_st lwwreg_effect msg st 14 | 15 | let table_of_lwwregs_init_st () = map_comb_init_st () 16 | 17 | let table_of_lwwregs_crdt : ('valTy table_of_lwwregs_opTy, 'valTy table_of_lwwregs_stTy) crdtTy = fun () -> (table_of_lwwregs_init_st, table_of_lwwregs_effect) 18 | 19 | let table_of_lwwregs_init (val_ser[@metavar]) (val_deser[@metavar]) (addrs : saddr alist) (rid : repIdTy) = 20 | let initRes = oplib_init (prod_ser string_ser val_ser) (prod_deser string_deser val_deser) addrs rid table_of_lwwregs_crdt in 21 | let (get_state, update) = initRes in 22 | (get_state, update) 23 | -------------------------------------------------------------------------------- /ml_sources/examples/crdt/oplib/examples/two_p_set/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name two_p_set_code) 3 | (flags :standard -rectypes) 4 | (libraries oplib_code aneris)) 5 | -------------------------------------------------------------------------------- /ml_sources/examples/crdt/oplib/examples/two_p_set/two_p_set_code.ml: -------------------------------------------------------------------------------- 1 | open !Ast 2 | open Set_code 3 | open Serialization_code 4 | open Oplib_code 5 | 6 | (* 2P set CRDT where elements can never be added once they are removed. *) 7 | 8 | type 'valTy stTy = ('valTy aset) * ('valTy aset) 9 | type 'valTy opTy = ('valTy, 'valTy) sumTy 10 | 11 | 12 | let init_st () : 'valTy stTy = (set_empty (), set_empty ()) 13 | 14 | let effect (msg : 'valTy opTy msgTy) (st : 'valTy stTy) = 15 | let ((v, _vc), _u) = msg in 16 | match v with 17 | | InjL w -> (set_add w (fst st),snd st) 18 | | InjR w -> (fst st, set_add w (snd st)) 19 | 20 | let tps_crdt : ('valTy opTy, 'valTy stTy) crdtTy = fun () -> (init_st, effect) 21 | 22 | let tps_init (val_ser[@metavar]) (val_deser[@metavar]) addrs rid = 23 | let initRes = oplib_init (sum_ser val_ser val_ser) (sum_deser val_deser val_deser) addrs rid tps_crdt in 24 | let (get_state, update) = initRes in 25 | (get_state, update) 26 | -------------------------------------------------------------------------------- /ml_sources/examples/crdt/statelib/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (wrapped false) 3 | (name statelib_code) 4 | (flags :standard -rectypes) 5 | (libraries aneris)) 6 | -------------------------------------------------------------------------------- /ml_sources/examples/crdt/statelib/examples/pncounter/counter_runner.ml: -------------------------------------------------------------------------------- 1 | open Unix 2 | open Ast 3 | open List_code 4 | open Counter_code 5 | open Statelib_code 6 | 7 | 8 | let handle_io i rd upd = 9 | let s = read_line () in 10 | match String.split_on_char ' ' s with 11 | | [ "read" ] -> Printf.printf "CTR[%n] : %n\n" i (rd ()) 12 | | [ "inc"; v_str ] -> 13 | let v = int_of_string v_str in 14 | let () = upd v in 15 | Printf.printf "CTR[%n] : %n\n" i (rd ()) 16 | | [ "dec"; v_str ] -> 17 | let v = int_of_string v_str in 18 | let () = upd (-v) in 19 | Printf.printf "CTR[%n] : %n\n" i (rd ()) 20 | | "close" :: _ -> exit 0 21 | | _ -> Printf.printf "invalid command \n" 22 | 23 | let init_exec () = 24 | if Array.length Sys.argv < 4 then ( 25 | prerr_endline "Usage: "; 26 | exit 2); 27 | let ip = string_of_inet_addr (gethostbyname "localhost").h_addr_list.(0) in 28 | let l = 29 | let sa i = SADDR (ip, (int_of_string Sys.argv.(i + 2))) in 30 | list_init (Array.length Sys.argv - 2) sa 31 | in 32 | let i = int_of_string Sys.argv.(1) in 33 | let p = counter_init l i in 34 | let read = fst p in 35 | let update = snd p in 36 | loop_forever (fun () -> handle_io i read update) 37 | 38 | let () = Unix.handle_unix_error init_exec () 39 | -------------------------------------------------------------------------------- /ml_sources/examples/crdt/statelib/examples/pncounter/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name counter_runner) 3 | (flags :standard -rectypes) 4 | (libraries statelib_code aneris)) -------------------------------------------------------------------------------- /ml_sources/examples/dscm/implementations/one_server/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (wrapped false) 3 | (name one_server) 4 | (flags :standard -rectypes) 5 | (libraries aneris)) -------------------------------------------------------------------------------- /ml_sources/examples/dscm/implementations/one_server/one_server_client_proxy_code.ml: -------------------------------------------------------------------------------- 1 | open Ast 2 | open One_server_serialization_code 3 | 4 | (* TODO: check and explain the code. *) 5 | let wait_for_reply (val_ser[@metavar]) srv sh reqId reqMsg = 6 | let rid = !reqId in 7 | let rec aux () = 8 | match receiveFrom sh with 9 | None -> ignore(sendTo sh reqMsg srv); aux () 10 | | Some rply -> 11 | let repl = (reply_serializer val_ser).s_deser (fst rply) in 12 | let (res, resId) = repl in 13 | assert (resId <= rid); 14 | if resId = rid 15 | then 16 | begin 17 | reqId := rid + 1; 18 | res 19 | end 20 | else aux () 21 | in aux () 22 | 23 | let request (val_ser[@metavar]) srv sh lock reqId req = 24 | (* Use lock to prevent client to run requests in parallel. *) 25 | acquire lock; 26 | let reqMsg = 27 | (request_serializer val_ser).s_ser (req, !reqId) in 28 | ignore(sendTo sh reqMsg srv); 29 | let r = wait_for_reply val_ser srv sh reqId reqMsg in 30 | release lock; 31 | r 32 | 33 | let install_proxy (val_ser[@metavar]) srv caddr = 34 | let sh = udp_socket () in 35 | let reqId = ref 0 in 36 | socketBind sh caddr; 37 | setReceiveTimeout sh 3 0; 38 | let lock = newlock () in 39 | let wr k v = request (val_ser[@metavar]) srv sh lock reqId (InjL (k, v)) in 40 | let rd k = request (val_ser[@metavar]) srv sh lock reqId (InjR k) in 41 | (wr, rd) 42 | -------------------------------------------------------------------------------- /ml_sources/examples/dscm/implementations/one_server/one_server_serialization_code.ml: -------------------------------------------------------------------------------- 1 | open !Ast 2 | open Serialization_code 3 | 4 | (** Serialization *) 5 | 6 | (* let clntId_serializer = saddr_serializer *) 7 | let seqId_serializer = int_serializer 8 | 9 | let write_serializer (val_ser[@metavar]) = 10 | prod_serializer string_serializer val_ser 11 | 12 | let read_serializer = string_serializer 13 | 14 | (* ⟨REQUEST op, c, s⟩ *) 15 | let request_serializer (val_ser[@metavar]) = 16 | prod_serializer 17 | (sum_serializer (write_serializer val_ser) read_serializer) 18 | seqId_serializer 19 | 20 | (* ⟨REPLY s, x, c⟩ *) 21 | let reply_serializer (val_ser[@metavar]) = 22 | prod_serializer 23 | (sum_serializer (unit_serializer) (option_serializer val_ser)) 24 | seqId_serializer 25 | -------------------------------------------------------------------------------- /ml_sources/examples/ping_pong_done/ping_pong_done_code.ml: -------------------------------------------------------------------------------- 1 | open Ast 2 | open Network_util_code 3 | 4 | let pong addr = 5 | let skt = udp_socket () in 6 | socketBind skt addr; 7 | (* Receiving the initial message. We check that the body is "PING". *) 8 | let msg = unSOME (receiveFrom skt) in 9 | let sender = snd msg in 10 | assert (fst msg = "PING"); 11 | (* Sending "PONG" in response *) 12 | ignore (sendTo skt "PONG" sender); 13 | (* When listening to the socket, we may receive duplicates of the initial 14 | * "PING" message. Thus, we proceed to a loop that ignores any received 15 | * until we receive a message that is not "PING". *) 16 | let rec loop () = 17 | let ack = unSOME (receiveFrom skt) in 18 | let body = fst ack in 19 | (* The body of the first message that is not "PING" is returned. *) 20 | if body = "PING" then loop () else body 21 | in loop () 22 | 23 | let ping addr server = 24 | let skt = udp_socket () in 25 | socketBind skt addr; 26 | (* Sending the inital "PING" message. *) 27 | ignore (sendTo skt "PING" server); 28 | (* Receiving a response. We have to check that the body of the message in "PONG". *) 29 | let msg = unSOME (receiveFrom skt) in 30 | assert (fst msg = "PONG"); 31 | (* Closing the protocol by sending the final "DONE" message. *) 32 | ignore (sendTo skt "DONE" server) 33 | -------------------------------------------------------------------------------- /ml_sources/examples/rcb/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (wrapped false) 3 | (name rcb_code) 4 | (flags :standard -rectypes) 5 | (libraries aneris)) 6 | -------------------------------------------------------------------------------- /ml_sources/examples/reliable_communication/client_server_code.mli: -------------------------------------------------------------------------------- 1 | open Ast 2 | 3 | type ('a, 'b) client_skt 4 | type ('a, 'b) server_skt 5 | type ('a, 'b) chan_descr 6 | val make_client_skt : 'a serializer -> 'b serializer -> saddr -> ('a, 'b) client_skt 7 | val make_server_skt : 'a serializer -> 'b serializer -> saddr -> ('a, 'b) server_skt 8 | val server_listen : ('a, 'b) server_skt -> unit 9 | val accept : ('a, 'b) server_skt -> ('a, 'b) chan_descr * saddr 10 | val connect : ('a, 'b) client_skt -> saddr -> ('a, 'b) chan_descr 11 | val send : ('a, 'b) chan_descr -> 'a -> unit 12 | val try_recv : ('a, 'b) chan_descr -> 'b option 13 | val recv : ('a, 'b) chan_descr -> 'b 14 | -------------------------------------------------------------------------------- /ml_sources/examples/reliable_communication/client_server_printing.ml: -------------------------------------------------------------------------------- 1 | open Ast 2 | open !Serialization_code 3 | open !Network_util_code 4 | 5 | let b = ref false 6 | 7 | let __print_recv_msg deser sa msg () = 8 | if !b 9 | then 10 | let (SADDR (s, i)) = sa in 11 | match deser (fst msg) with 12 | | InjL repl -> 13 | Printf.printf "(%s, %d) ---received---> HNDSHK packet %s,%d: \n%!" 14 | s i (fst repl) (snd repl) 15 | | InjR (InjL _) -> 16 | Printf.printf 17 | "(%s, %d) ---received---> ACKID packet: %s.\n%!" s i (fst msg) 18 | | InjR (InjR _) -> 19 | Printf.printf 20 | "(%s, %d) ---received---> SEQID packet: %s.\n%!" s i (fst msg) 21 | 22 | let __print_send_msg ser sa bdy () = 23 | if !b 24 | then 25 | let msg = ser bdy in 26 | let (SADDR (s, i)) = sa in 27 | match bdy with 28 | | InjL init -> 29 | Printf.printf "(%s, %d) <-----send----- HNDSHK packet %s,%d: \n%!" 30 | s i (fst init) (snd init) 31 | | InjR (InjL _) -> 32 | Printf.printf 33 | "(%s, %d) <-----send----- ACKID packet: %s.\n%!" s i msg 34 | | InjR (InjR _) -> 35 | Printf.printf 36 | "(%s, %d) <-----send----- SEQID packet: %s.\n%!" s i msg 37 | 38 | let __print_send_handshake_msg sa msg () = 39 | if !b 40 | then 41 | let (SADDR (s, i)) = sa in 42 | Printf.printf "(%s, %d) <-----send----- HNDSHK packet %s: \n%!" 43 | s i msg 44 | 45 | let __print_new_chan clt_addr () = 46 | if !b 47 | then 48 | let (SADDR (s, i)) = clt_addr in 49 | Printf.printf "New channel created associated with saddr (%s, %d)\n%!" s i 50 | -------------------------------------------------------------------------------- /ml_sources/examples/reliable_communication/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name client_server_code) 3 | (flags :standard -rectypes) 4 | (libraries aneris)) 5 | -------------------------------------------------------------------------------- /ml_sources/examples/reliable_communication/examples/dlm_db_example/dlm_db_example_code.ml: -------------------------------------------------------------------------------- 1 | open !Ast 2 | open Serialization_code 3 | open Dlm_code 4 | open Repdb_code 5 | 6 | let do_writes lk wr = 7 | dlock_acquire lk; 8 | wr "x" 37; 9 | wr "y" 1; 10 | dlock_release lk 11 | 12 | let do_reads lk rd = 13 | let rec loop () = 14 | dlock_acquire lk; 15 | let vx = rd "x" in 16 | if vx = Some 37 17 | then 18 | begin 19 | let vy = rd "y" in 20 | assert (vy = Some 1); 21 | dlock_release lk; 22 | vy 23 | end 24 | else 25 | begin 26 | dlock_release lk; 27 | unsafe (fun () -> Unix.sleepf 2.0); 28 | loop () 29 | end 30 | in loop () 31 | 32 | let node0 clt_addr00 clt_addr01 dl_addr db_laddr = 33 | let lk_chan = dlock_subscribe_client clt_addr00 dl_addr in 34 | let db_funs = init_client_leader_proxy int_serializer clt_addr01 db_laddr in 35 | let (wr, _rd) = db_funs in 36 | do_writes lk_chan wr 37 | 38 | let node1 clt_addr10 clt_addr11 dl_addr db_laddr = 39 | let lk_chan = dlock_subscribe_client clt_addr10 dl_addr in 40 | let db_funs = init_client_leader_proxy int_serializer clt_addr11 db_laddr in 41 | let (_wr, rd) = db_funs in 42 | do_reads lk_chan rd 43 | -------------------------------------------------------------------------------- /ml_sources/examples/reliable_communication/examples/dlm_db_example/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name dlm_db_example_code) 3 | (flags :standard -rectypes) 4 | (libraries dlm_code repdb_code aneris)) -------------------------------------------------------------------------------- /ml_sources/examples/reliable_communication/examples/hello_world/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name hello_world_code) 3 | (flags :standard -rectypes) 4 | (libraries client_server_code aneris)) -------------------------------------------------------------------------------- /ml_sources/examples/reliable_communication/examples/hello_world/hello_world_code.ml: -------------------------------------------------------------------------------- 1 | open !Ast 2 | open Client_server_code 3 | open Serialization_code 4 | 5 | let server srv_addr = 6 | let skt = make_server_skt 7 | string_serializer 8 | string_serializer 9 | srv_addr in 10 | server_listen skt; 11 | let new_conn = accept skt in 12 | let (c, _clt_addr) = new_conn in 13 | let (req : string) = recv c in 14 | send c req 15 | 16 | 17 | let client clt_addr srv_addr = 18 | let skt = make_client_skt 19 | string_serializer 20 | string_serializer 21 | clt_addr in 22 | let ch = connect skt srv_addr in 23 | send ch "Hello World!" 24 | -------------------------------------------------------------------------------- /ml_sources/examples/reliable_communication/examples/hello_world_2/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name hello_world_2_code) 3 | (flags :standard -rectypes) 4 | (libraries client_server_code aneris)) -------------------------------------------------------------------------------- /ml_sources/examples/reliable_communication/examples/hello_world_2/hello_world_2_code.ml: -------------------------------------------------------------------------------- 1 | open !Ast 2 | open Client_server_code 3 | open Serialization_code 4 | 5 | let server srv_addr = 6 | let skt = make_server_skt 7 | string_serializer 8 | string_serializer 9 | srv_addr in 10 | server_listen skt; 11 | let new_conn = accept skt in 12 | let (clt_c, _clt_addr) = new_conn in 13 | let (req : string) = recv clt_c in 14 | send clt_c req 15 | 16 | 17 | let client clt_addr0 clt_addr1 srv_addr0 srv_addr1 = 18 | let skt0 = make_client_skt string_serializer string_serializer clt_addr0 in 19 | let skt1 = make_client_skt string_serializer string_serializer clt_addr1 in 20 | let ch0 = connect skt0 srv_addr0 in 21 | let ch1 = connect skt1 srv_addr1 in 22 | send ch0 "Hello World, Server 0!"; 23 | send ch1 "Hello World, Server 1!" 24 | -------------------------------------------------------------------------------- /ml_sources/examples/reliable_communication/examples/messages_in_order/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name messages_in_order_runner) 3 | (flags :standard -rectypes) 4 | (libraries client_server_code aneris)) -------------------------------------------------------------------------------- /ml_sources/examples/reliable_communication/examples/messages_in_order/messages_in_order_code.ml: -------------------------------------------------------------------------------- 1 | open !Ast 2 | open Serialization_code 3 | open Client_server_code 4 | 5 | let server srv = 6 | unsafe (fun () -> Printf.printf "Install server.\n%!"); 7 | unsafe (fun () -> Printf.printf "Creating socket.\n%!"); 8 | let s = make_server_skt int_serializer int_serializer srv in 9 | unsafe (fun () -> Printf.printf "Start listening.\n%!"); 10 | server_listen s; 11 | let new_conn = accept s in 12 | let (c, _clt) = new_conn in 13 | let _r1 = let m = recv c in send c m in 14 | let _r2 = let m = recv c in send c m in 15 | let _r3 = let m = recv c in send c m in 16 | () 17 | 18 | let client clt srv = 19 | unsafe (fun () -> Printf.printf "Install client.\n%!"); 20 | unsafe (fun () -> Printf.printf "Creating socket.\n%!"); 21 | let s = make_client_skt int_serializer int_serializer clt in 22 | unsafe (fun () -> Printf.printf "Connecting to the server.\n%!"); 23 | let c = connect s srv in 24 | send c 1; 25 | send c 2; 26 | send c 3; 27 | let m1 = recv c in 28 | let m2 = recv c in 29 | let m3 = recv c in 30 | assert (m1 = 1 && m2 = 2 && m3 = 3); 31 | 32 | 33 | (* 34 | let server srv = 35 | let s = make_server_skt int_serializer int_serializer srv in 36 | server_listen s; 37 | let new_conn = accept s in 38 | let (c, _clt) = new_conn in 39 | let _r1 = let m = recv c in send c m in 40 | let _r2 = let m = recv c in send c m in 41 | let _r1 = let m = recv c in send c m in 42 | () 43 | 44 | let client clt srv = 45 | let s = make_client_skt int_serializer int_serializer clt in 46 | let c = connect s srv in 47 | send c 1; send c 2; send c 3; 48 | let m1 = recv c in 49 | let m2 = recv c in 50 | let m3 = recv c in 51 | assert (m1 = 1 && m2 = 2 && m3 = 3) 52 | *) 53 | -------------------------------------------------------------------------------- /ml_sources/examples/reliable_communication/examples/messages_in_order/messages_in_order_runner.ml: -------------------------------------------------------------------------------- 1 | open Unix 2 | open Ast 3 | open Messages_in_order_code 4 | 5 | let monitor_send_faults () = 6 | let loop () = 7 | while true do 8 | Unix.sleepf 1.0; 9 | print_send_faults (); 10 | done in 11 | ignore (Thread.create loop ()) 12 | 13 | let ip = (gethostbyname "localhost").h_addr_list.(0) 14 | let clt_saddr = makeAddress (string_of_inet_addr ip) 1100 15 | let srv_saddr = makeAddress (string_of_inet_addr ip) 1101 16 | 17 | let runner () = 18 | if Array.length Sys.argv < 2 19 | then (prerr_endline "Usage: \n\ 20 | \ where is in {clt srv}"; exit 2); 21 | sendTo_sim_flag := true; 22 | set_send_fault_flags 300 600 100; 23 | Printf.printf "Press any key to start the node %!"; 24 | let _ = read_line () in 25 | let _ = 26 | match Sys.argv.(1) with 27 | | "clt" -> 28 | client clt_saddr srv_saddr; 29 | Printf.printf "Assertion succeeded!\n%!"; 30 | monitor_send_faults (); 31 | fork (let rec loop () = Unix.sleepf 10.0; loop () in loop ()) () 32 | | "srv" -> 33 | server srv_saddr; 34 | monitor_send_faults (); 35 | fork (let rec loop () = Unix.sleepf 10.0; loop () in loop ()) () 36 | 37 | | _ -> assert false 38 | in () 39 | 40 | let () = runner () 41 | -------------------------------------------------------------------------------- /ml_sources/examples/reliable_communication/examples/messages_in_order/run.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | 4 | EXE="~/repositories/portal/aneris-examples/_build/default/ml_sources/reliable_communication/examples/messages_in_order/messages_in_order_runner.exe" 5 | 6 | RUN () { 7 | osascript -e 'tell app "Terminal" to do script "'"${EXE//\"/\\\"} ${1//\"/\\\"} ${2//\"/\\\"}"'"' 8 | } 9 | 10 | cd ~/repositories/portal/aneris-examples/ 11 | 12 | dune build 13 | 14 | cd ~/repositories/portal/aneris-examples/ml_sources/reliable_communication/examples/messages_in_order/ 15 | 16 | RUN clt 17 | RUN srv 18 | -------------------------------------------------------------------------------- /ml_sources/examples/reliable_communication/examples/messages_in_order_loop/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name messages_in_order_loop_code) 3 | (flags :standard -rectypes) 4 | (libraries client_server_code aneris)) -------------------------------------------------------------------------------- /ml_sources/examples/reliable_communication/examples/messages_in_order_loop/messages_in_order_loop.ml: -------------------------------------------------------------------------------- 1 | 2 | -------------------------------------------------------------------------------- /ml_sources/examples/reliable_communication/examples/messages_in_order_loop/messages_in_order_loop_code.ml: -------------------------------------------------------------------------------- 1 | open !Ast 2 | open Serialization_code 3 | open Client_server_code 4 | 5 | let int_s = int_serializer 6 | let str_s = string_serializer 7 | 8 | let rec echo_loop c = 9 | let req = recv c in 10 | send c (strlen req); 11 | echo_loop c 12 | 13 | let accept_loop s = 14 | let rec loop () = 15 | let c = fst (accept s) in 16 | fork echo_loop c; loop () 17 | in loop () 18 | 19 | let server srv = 20 | let s = make_server_skt int_s str_s srv in 21 | server_listen s; 22 | fork accept_loop s 23 | 24 | let client clt srv s1 s2 = 25 | let s = make_client_skt str_s int_s clt in 26 | let c = connect s srv in 27 | send c s1; send c s2; 28 | let m1 = recv c in 29 | let m2 = recv c in 30 | assert (m1 = strlen s1 && m2 = strlen s2) 31 | 32 | let client_0 clt srv = 33 | client clt srv "carpe" "diem" 34 | -------------------------------------------------------------------------------- /ml_sources/examples/reliable_communication/examples/repdb_leader_followers/causality_example_code.ml: -------------------------------------------------------------------------------- 1 | open !Ast 2 | open Serialization_code 3 | open Repdb_code 4 | 5 | let do_writes wr = 6 | wr "x" 37; 7 | wr "y" 1 8 | 9 | let wait_on_read rd k v = 10 | let rec loop () = 11 | let res = rd k in 12 | if res = Some v 13 | then () 14 | else (unsafe (fun () -> Unix.sleepf 2.0); loop ()) 15 | in loop () 16 | 17 | let do_reads rd = 18 | wait_on_read rd "y" 1; 19 | let vx = rd "x" in 20 | assert (vx = Some 37) 21 | 22 | let node0 clt_addr0 db_laddr = 23 | let db_funs = init_client_leader_proxy int_serializer clt_addr0 db_laddr in 24 | let (wr, _rd) = db_funs in 25 | do_writes wr 26 | 27 | let node1 clt_addr1 faddr = 28 | let rd = init_client_follower_proxy int_serializer clt_addr1 faddr in 29 | do_reads rd 30 | -------------------------------------------------------------------------------- /ml_sources/examples/reliable_communication/examples/repdb_leader_followers/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name causality_example_code) 3 | (flags :standard -rectypes) 4 | (libraries repdb_code aneris)) -------------------------------------------------------------------------------- /ml_sources/examples/reliable_communication/examples/sharding_examples/causality_example_code.ml: -------------------------------------------------------------------------------- 1 | open !Ast 2 | open Serialization_code 3 | open Sharding_code 4 | 5 | let do_writes wr = 6 | wr "x" 37; 7 | wr "y" 1 8 | 9 | let wait_on_read rd k v = 10 | let rec loop () = 11 | let res = rd k in 12 | if res = Some v 13 | then () 14 | else (unsafe (fun () -> Unix.sleepf 2.0); loop ()) 15 | in loop () 16 | 17 | let do_reads rd = 18 | wait_on_read rd "y" 1; 19 | let vx = rd "x" in 20 | assert (vx = Some 37) 21 | 22 | let node0 clt_addr0 db_addr = 23 | let db_funs = init_client string_serializer int_serializer clt_addr0 db_addr in 24 | let wr = fst db_funs in 25 | do_writes wr 26 | 27 | let node1 clt_addr1 db_addr = 28 | let db_funs = init_client string_serializer int_serializer clt_addr1 db_addr in 29 | let rd = snd db_funs in 30 | do_reads rd 31 | 32 | let hash k = 33 | if k = "x" then 0 else 1 34 | -------------------------------------------------------------------------------- /ml_sources/examples/reliable_communication/examples/sharding_examples/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name causality_example_code) 3 | (flags :standard -rectypes) 4 | (libraries sharding_code aneris)) 5 | -------------------------------------------------------------------------------- /ml_sources/examples/reliable_communication/lib/ddb/ddb_code.mli: -------------------------------------------------------------------------------- 1 | open Ast 2 | 3 | val install_proxy : 4 | 'a serializer -> saddr -> saddr -> 5 | ((string -> 'a -> unit) * (string -> 'a option)) 6 | 7 | val init_server : 'a serializer -> saddr -> unit 8 | -------------------------------------------------------------------------------- /ml_sources/examples/reliable_communication/lib/ddb/ddb_serialization_code.ml: -------------------------------------------------------------------------------- 1 | open Ast 2 | open Map_code 3 | open Serialization_code 4 | open Client_server_code 5 | 6 | 7 | type 'a requestTy = (string * 'a, string) sumTy 8 | type 'a replyTy = (unit, 'a option) sumTy 9 | type 'a db_chan_descr = ('a replyTy, 'a requestTy) chan_descr 10 | type 'a requestEventTy = 'a requestTy * 'a db_chan_descr 11 | type 'a replyEventTy = 'a replyTy * 'a db_chan_descr 12 | type 'a databaseTy = ((string, 'a) amap) 13 | 14 | let write_serializer (val_ser[@metavar]) = 15 | prod_serializer string_serializer val_ser 16 | 17 | let read_serializer = string_serializer 18 | 19 | (* ⟨REQUEST op, c, s⟩ *) 20 | let request_serializer (val_ser[@metavar]) = 21 | (sum_serializer (write_serializer val_ser) read_serializer) 22 | 23 | (* ⟨REPLY s, x, c⟩ *) 24 | let reply_serializer (val_ser[@metavar]) = 25 | (sum_serializer (unit_serializer) (option_serializer val_ser)) 26 | -------------------------------------------------------------------------------- /ml_sources/examples/reliable_communication/lib/ddb/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name ddb_code) 3 | (flags :standard -rectypes) 4 | (libraries aneris client_server_code)) 5 | -------------------------------------------------------------------------------- /ml_sources/examples/reliable_communication/lib/dlm/dlm_code.mli: -------------------------------------------------------------------------------- 1 | open Ast 2 | 3 | type dlock 4 | val dlock_start_service : saddr -> 'a 5 | val dlock_subscribe_client : saddr -> saddr -> dlock 6 | val dlock_acquire : dlock -> unit 7 | val dlock_release : dlock -> unit 8 | -------------------------------------------------------------------------------- /ml_sources/examples/reliable_communication/lib/dlm/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name dlm_code) 3 | (flags :standard -rectypes) 4 | (libraries client_server_code aneris)) -------------------------------------------------------------------------------- /ml_sources/examples/reliable_communication/lib/kvls/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name kvls_code) 3 | (flags :standard -rectypes) 4 | (libraries aneris mt_server_code)) 5 | -------------------------------------------------------------------------------- /ml_sources/examples/reliable_communication/lib/mt_server/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name mt_server_code) 3 | (flags :standard -rectypes) 4 | (libraries aneris client_server_code)) 5 | -------------------------------------------------------------------------------- /ml_sources/examples/reliable_communication/lib/mt_server/mt_server_code.mli: -------------------------------------------------------------------------------- 1 | open Ast 2 | 3 | type ('a, 'b) rpc 4 | 5 | val run_server : 'repl serializer -> 'req serializer -> 6 | saddr -> ('req -> 'repl) -> unit 7 | 8 | val run_server_opt : 'repl serializer -> 'req serializer -> 9 | saddr -> ('req option -> 'repl option) -> unit 10 | 11 | val make_request : ('req, 'repl) rpc -> ('req -> 'repl) 12 | 13 | val init_client_proxy : 'req serializer -> 'repl serializer -> 14 | saddr -> saddr -> ('req, 'repl) rpc 15 | -------------------------------------------------------------------------------- /ml_sources/examples/reliable_communication/lib/repdb/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name repdb_code) 3 | (flags :standard -rectypes) 4 | (libraries aneris mt_server_code)) 5 | -------------------------------------------------------------------------------- /ml_sources/examples/reliable_communication/lib/repdb/log_code.ml: -------------------------------------------------------------------------------- 1 | open Ast 2 | open List_code 3 | 4 | type 'a log = ('a alist * int) Atomic.t 5 | 6 | (* -------------------------------------------------------------------------- *) 7 | (** Operations on log of requests *) 8 | (* -------------------------------------------------------------------------- *) 9 | 10 | (* TODO: The logs below should use by resizeable arrays instead of lists! *) 11 | let log_create () : 'a log = ref (list_nil, 0) (* the log and next free index. *) 12 | 13 | let log_add_entry (log : 'a log) (req : 'a) = 14 | let lp = !log in 15 | let (data, next) = lp in 16 | let data' = list_append data (list_cons req list_nil) in 17 | log := (data', next + 1) 18 | 19 | let log_next (log : 'a log) = snd !log 20 | 21 | let log_length (log : 'a log) = snd !log 22 | 23 | let log_get (log : 'a log) (i : int) : 'a option = 24 | list_nth (fst !log) i 25 | 26 | let log_wait_until log mon i : unit = 27 | let rec aux () = 28 | let n = log_next log in 29 | if n = i then begin monitor_wait mon; aux () end 30 | else assert (i < n) 31 | in 32 | if i < 0 ||log_next log < i then assert false 33 | else aux () 34 | 35 | (* let log_get_suf (i: int) (log : 'a log) : 'a log_entry alist * int = 36 | * (list_suf i (fst !log), (snd !log - i)) *) 37 | -------------------------------------------------------------------------------- /ml_sources/examples/reliable_communication/lib/repdb/repdb_code.mli: -------------------------------------------------------------------------------- 1 | open !Ast 2 | 3 | val init_leader : 'a serializer -> saddr -> saddr -> unit 4 | val init_follower : 'a serializer -> saddr -> saddr -> saddr -> unit 5 | val init_client_leader_proxy : 'a serializer -> saddr -> saddr -> 6 | (string -> 'a -> unit) * (string -> 'a option) 7 | val init_client_follower_proxy : 'a serializer -> saddr -> saddr -> 8 | (string -> 'a option) 9 | -------------------------------------------------------------------------------- /ml_sources/examples/reliable_communication/lib/sharding/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name sharding_code) 3 | (flags :standard -rectypes) 4 | (libraries aneris mt_server_code)) 5 | -------------------------------------------------------------------------------- /ml_sources/examples/stenning/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name stenning_code) 3 | (flags :standard -rectypes) 4 | (libraries aneris)) 5 | -------------------------------------------------------------------------------- /ml_sources/examples/stenning/stenning_code.ml: -------------------------------------------------------------------------------- 1 | open! Ast 2 | open List_code 3 | open Network_util_code 4 | 5 | let server_aux addr j0 = 6 | let sckt = udp_socket () in 7 | socketBind sckt addr; 8 | let rec handler j msg sender = 9 | let tag = unSOME (s2i (tag_of_message msg)) in 10 | let value = value_of_message msg in 11 | if j = tag then 12 | (ignore(sendTo sckt ((i2s tag) ^ "_" ^ value) sender); 13 | listen sckt (handler (j + 1))) 14 | else 15 | (ignore(sendTo sckt ((i2s tag) ^ "_" ^ value) sender); 16 | listen sckt (handler j)) 17 | in listen sckt (handler j0) 18 | 19 | let server addr = server_aux addr 0 20 | 21 | 22 | let client_aux addr srvr mlst i0 = 23 | let sckt = udp_socket () in 24 | socketBind sckt addr; 25 | let rslt = ref (list_rev (list_sub i0 mlst)) in 26 | let rec next_step i = 27 | if i < list_length mlst 28 | then 29 | let ith = unSOME (list_nth mlst i) in 30 | let msg = (i2s i) ^ "_" ^ ith in 31 | ignore(sendTo sckt msg srvr); 32 | let rec handler rsp from = 33 | if from = srvr then 34 | let tag = unSOME (s2i (tag_of_message rsp)) in 35 | let value = value_of_message rsp in 36 | if tag = i 37 | then (rslt := list_cons value !rslt; next_step (i + 1)) 38 | else (ignore(sendTo sckt msg srvr); listen sckt handler) 39 | else listen sckt handler 40 | in listen sckt handler 41 | else list_rev !rslt 42 | in next_step i0 43 | 44 | let client addr srvr mlst = 45 | client_aux addr srvr mlst 0 46 | 47 | let test _d = newlock () 48 | -------------------------------------------------------------------------------- /ml_sources/examples/transactional_consistency/read_committed/examples/commit_order/commit_order_code.ml: -------------------------------------------------------------------------------- 1 | open !Ast 2 | open Serialization_code 3 | open Snapshot_isolation_code 4 | open Util_code 5 | 6 | let transaction1 cst = 7 | start cst; 8 | write cst "x" 1; 9 | let vy = read cst "y" in 10 | if (vy = Some 1) then ( 11 | write cst "a" 1; 12 | ); 13 | commitU cst 14 | 15 | let transaction2 cst = 16 | start cst; 17 | write cst "y" 1; 18 | let vx = read cst "x" in 19 | if (vx = Some 1) then ( 20 | write cst "b" 1; 21 | ); 22 | commitU cst 23 | 24 | let transaction3 cst = 25 | start cst; 26 | let va = read cst "a" in 27 | let vb = read cst "b" in 28 | assert (not (va = Some 1 && vb = Some 1)); 29 | commitU cst 30 | 31 | let transaction1_client caddr kvs_addr = 32 | let cst = init_client_proxy int_serializer caddr kvs_addr in 33 | transaction1 cst 34 | 35 | let transaction2_client caddr kvs_addr = 36 | let cst = init_client_proxy int_serializer caddr kvs_addr in 37 | transaction2 cst 38 | 39 | let transaction3_client caddr kvs_addr = 40 | let cst = init_client_proxy int_serializer caddr kvs_addr in 41 | transaction3 cst 42 | 43 | let server srv = 44 | init_server int_serializer srv 45 | -------------------------------------------------------------------------------- /ml_sources/examples/transactional_consistency/read_committed/examples/commit_order/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name commit_order_code) 3 | (flags :standard -rectypes) 4 | (libraries client_server_code snapshot_isolation_code util_code aneris)) 5 | -------------------------------------------------------------------------------- /ml_sources/examples/transactional_consistency/read_committed/examples/dirty_read/dirty_read_code.ml: -------------------------------------------------------------------------------- 1 | open !Ast 2 | open Serialization_code 3 | open Snapshot_isolation_code 4 | open Util_code 5 | 6 | let transaction1 cst = 7 | start cst; 8 | write cst "x" 1; 9 | loop () 10 | 11 | let transaction2 cst = 12 | start cst; 13 | let vx = read cst "x" in 14 | assert (vx = None); 15 | commitU cst 16 | 17 | let transaction1_client caddr kvs_addr = 18 | let cst = init_client_proxy int_serializer caddr kvs_addr in 19 | transaction1 cst 20 | 21 | let transaction2_client caddr kvs_addr = 22 | let cst = init_client_proxy int_serializer caddr kvs_addr in 23 | transaction2 cst 24 | 25 | let server srv = 26 | init_server int_serializer srv 27 | -------------------------------------------------------------------------------- /ml_sources/examples/transactional_consistency/read_committed/examples/dirty_read/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name dirty_read_code) 3 | (flags :standard -rectypes) 4 | (libraries client_server_code snapshot_isolation_code util_code aneris)) 5 | -------------------------------------------------------------------------------- /ml_sources/examples/transactional_consistency/read_uncommitted/examples/read_own_data/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name read_own_data_code) 3 | (flags :standard -rectypes) 4 | (libraries client_server_code snapshot_isolation_code util_code aneris)) -------------------------------------------------------------------------------- /ml_sources/examples/transactional_consistency/read_uncommitted/examples/read_own_data/read_own_data_code.ml: -------------------------------------------------------------------------------- 1 | open !Ast 2 | open Serialization_code 3 | open Snapshot_isolation_code 4 | open Util_code 5 | 6 | let transaction1 cst = 7 | start cst; 8 | write cst "x" 1; 9 | commitU cst 10 | 11 | let transaction2 cst = 12 | start cst; 13 | write cst "x" 2; 14 | let vx = read cst "x" in 15 | assert (vx = Some 2); 16 | commitU cst 17 | 18 | let transaction1_client caddr kvs_addr = 19 | let cst = init_client_proxy int_serializer caddr kvs_addr in 20 | transaction1 cst 21 | 22 | let transaction2_client caddr kvs_addr = 23 | let cst = init_client_proxy int_serializer caddr kvs_addr in 24 | transaction2 cst 25 | 26 | let server srv = 27 | init_server int_serializer srv 28 | -------------------------------------------------------------------------------- /ml_sources/examples/transactional_consistency/read_uncommitted/examples/read_uncommitted_data/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name read_uncommitted_data_code) 3 | (flags :standard -rectypes) 4 | (libraries client_server_code snapshot_isolation_code util_code aneris)) -------------------------------------------------------------------------------- /ml_sources/examples/transactional_consistency/read_uncommitted/examples/read_uncommitted_data/read_uncommitted_data_code.ml: -------------------------------------------------------------------------------- 1 | open !Ast 2 | open Serialization_code 3 | open Snapshot_isolation_code 4 | open Util_code 5 | 6 | let transaction1 cst = 7 | start cst; 8 | write cst "x" 1; 9 | loop () 10 | 11 | let transaction2 cst = 12 | start cst; 13 | let vx = read cst "x" in 14 | assert (vx = None || vx = Some 1); 15 | commitU cst 16 | 17 | let transaction1_client caddr kvs_addr = 18 | let cst = init_client_proxy int_serializer caddr kvs_addr in 19 | transaction1 cst 20 | 21 | let transaction2_client caddr kvs_addr = 22 | let cst = init_client_proxy int_serializer caddr kvs_addr in 23 | transaction2 cst 24 | 25 | let server srv = 26 | init_server int_serializer srv 27 | -------------------------------------------------------------------------------- /ml_sources/examples/transactional_consistency/snapshot_isolation/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (wrapped false) 3 | (name snapshot_isolation_code) 4 | (flags :standard -rectypes) 5 | (libraries aneris mt_server_code)) 6 | -------------------------------------------------------------------------------- /ml_sources/examples/transactional_consistency/snapshot_isolation/examples/bank_transfer/bank_transfer_code.ml: -------------------------------------------------------------------------------- 1 | open !Ast 2 | open Serialization_code 3 | open Snapshot_isolation_code 4 | open Util_code 5 | 6 | let transaction cst amount src dst = 7 | start cst; 8 | let vsrc = unSOME (read cst src) in 9 | if (amount <= vsrc) then ( 10 | write cst src (vsrc - amount); 11 | let vdst = unSOME (read cst dst) in 12 | write cst dst (vdst + amount) 13 | ); 14 | commitU cst 15 | -------------------------------------------------------------------------------- /ml_sources/examples/transactional_consistency/snapshot_isolation/examples/bank_transfer/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name bank_transfer_code) 3 | (flags :standard -rectypes) 4 | (libraries client_server_code snapshot_isolation_code util_code aneris)) 5 | -------------------------------------------------------------------------------- /ml_sources/examples/transactional_consistency/snapshot_isolation/examples/causality_example/causality_example_code.ml: -------------------------------------------------------------------------------- 1 | open !Ast 2 | open Serialization_code 3 | open Snapshot_isolation_code 4 | open Util_code 5 | 6 | let transaction1 cst = 7 | start cst; 8 | write cst "x" 1; 9 | commitU cst 10 | 11 | let transaction2 cst = 12 | wait_transaction cst (fun v -> v = 1) "x"; 13 | start cst; 14 | write cst "y" 1; 15 | commitU cst 16 | 17 | let transaction3 cst = 18 | wait_transaction cst (fun v -> v = 1) "y"; 19 | start cst; 20 | let vx = read cst "x" in 21 | assert (vx = Some 1); 22 | commitU cst 23 | 24 | let transaction1_client caddr kvs_addr = 25 | let cst = init_client_proxy int_serializer caddr kvs_addr in 26 | transaction1 cst 27 | 28 | let transaction2_client caddr kvs_addr = 29 | let cst = init_client_proxy int_serializer caddr kvs_addr in 30 | transaction2 cst 31 | 32 | let transaction3_client caddr kvs_addr = 33 | let cst = init_client_proxy int_serializer caddr kvs_addr in 34 | transaction3 cst 35 | 36 | let server srv = 37 | init_server int_serializer srv 38 | -------------------------------------------------------------------------------- /ml_sources/examples/transactional_consistency/snapshot_isolation/examples/causality_example/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name causality_example_code) 3 | (flags :standard -rectypes) 4 | (libraries client_server_code snapshot_isolation_code util_code aneris)) 5 | -------------------------------------------------------------------------------- /ml_sources/examples/transactional_consistency/snapshot_isolation/examples/classical_example/classical_example_code.ml: -------------------------------------------------------------------------------- 1 | open !Ast 2 | open Serialization_code 3 | open Snapshot_isolation_code 4 | open Util_code 5 | 6 | let transaction1 cst = 7 | start cst; 8 | write cst "x" 1; 9 | write cst "y" 1; 10 | commitU cst 11 | 12 | let transaction2 cst = 13 | start cst; 14 | write cst "x" 2; 15 | write cst "y" 2; 16 | commitU cst 17 | 18 | let transaction3 cst = 19 | start cst; 20 | let vx = read cst "x" in 21 | let vy = read cst "y" in 22 | assert(vx = vy); 23 | commitU cst 24 | 25 | let transaction1_client caddr kvs_addr = 26 | let cst = init_client_proxy int_serializer caddr kvs_addr in 27 | transaction1 cst 28 | 29 | let transaction2_client caddr kvs_addr = 30 | let cst = init_client_proxy int_serializer caddr kvs_addr in 31 | transaction2 cst 32 | 33 | let transaction3_client caddr kvs_addr = 34 | let cst = init_client_proxy int_serializer caddr kvs_addr in 35 | transaction3 cst 36 | 37 | let server srv = 38 | init_server int_serializer srv 39 | -------------------------------------------------------------------------------- /ml_sources/examples/transactional_consistency/snapshot_isolation/examples/classical_example/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name classical_example_code) 3 | (flags :standard -rectypes) 4 | (libraries client_server_code snapshot_isolation_code util_code aneris)) 5 | -------------------------------------------------------------------------------- /ml_sources/examples/transactional_consistency/snapshot_isolation/examples/deprecated/anomalie/anomalie_runner.ml: -------------------------------------------------------------------------------- 1 | (* open Unix 2 | open Ast 3 | open !Anomalie_code 4 | 5 | 6 | let ip = (gethostbyname "localhost").h_addr_list.(0) 7 | let srv_addr = makeAddress (string_of_inet_addr ip) 1100 8 | let clt_addr n = makeAddress (string_of_inet_addr ip) (1100 + n) 9 | 10 | let runner () = 11 | if Array.length Sys.argv < 1 12 | then (prerr_endline "Usage: \n\ 13 | \ where is in {0-4}"; exit 2); 14 | (* sendTo_sim_flag := true; *) 15 | (* set_send_fault_flags 200 700 100; *) 16 | (* Printf.printf "Press any key to start the node %!"; *) 17 | (* let _ = read_line () in *) 18 | let n = int_of_string (Sys.argv.(1)) in 19 | if n = 0 20 | then 21 | (server srv_addr; 22 | fork (let rec loop () = Unix.sleepf 10.0; loop () in loop ()) ()) 23 | else if n = 1 24 | then node_init (clt_addr 1) srv_addr 25 | else if n = 2 26 | then node_withdraw_ten (clt_addr 2) srv_addr 27 | else if n = 3 28 | then node_deposit_twenty (clt_addr 3) srv_addr 29 | else if n = 4 30 | then node_check_account (clt_addr 4) (clt_addr 5) srv_addr 31 | else assert false 32 | 33 | let () = runner () *) 34 | -------------------------------------------------------------------------------- /ml_sources/examples/transactional_consistency/snapshot_isolation/examples/deprecated/anomalie/dune: -------------------------------------------------------------------------------- 1 | 2 | (executable 3 | (name anomalie_runner) 4 | (flags :standard -rectypes) 5 | (libraries client_server_code snapshot_isolation_code util_code aneris)) -------------------------------------------------------------------------------- /ml_sources/examples/transactional_consistency/snapshot_isolation/examples/deprecated/anomalie/run.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | 4 | EXE="~/research/aneris/ml_sources/_build/default/examples/snapshot_isolation/examples/deprecated/anomalie/anomalie_runner.exe" 5 | 6 | RUN () { 7 | osascript -e 'tell app "Terminal" to do script "'"${EXE//\"/\\\"} ${1//\"/\\\"} ${2//\"/\\\"}"'"' 8 | } 9 | 10 | cd ~/research/aneris/ml_sources 11 | 12 | dune build 13 | 14 | cd ~/research/aneris/ml_sources/examples/snapshot_isolation/examples/anomalie/ 15 | 16 | RUN 0; 17 | RUN 1; 18 | RUN 2; 19 | RUN 3; 20 | RUN 4; 21 | -------------------------------------------------------------------------------- /ml_sources/examples/transactional_consistency/snapshot_isolation/examples/deprecated/classical_example_run/classical_example_run_code.ml: -------------------------------------------------------------------------------- 1 | open !Ast 2 | open Serialization_code 3 | open Snapshot_isolation_code 4 | open Util_code 5 | 6 | let transaction1 cst = 7 | write cst "x" 1; 8 | write cst "y" 1 9 | 10 | let transaction2 cst = 11 | write cst "x" 2; 12 | write cst "y" 2 13 | 14 | let transaction3 cst = 15 | let vx = read cst "x" in 16 | let vy = read cst "y" in 17 | assert(vx = vy) 18 | 19 | let transaction1_client caddr kvs_addr = 20 | let cst = init_client_proxy int_serializer caddr kvs_addr in 21 | run cst transaction1 22 | 23 | let transaction2_client caddr kvs_addr = 24 | let cst = init_client_proxy int_serializer caddr kvs_addr in 25 | run cst transaction2 26 | 27 | let transaction3_client caddr kvs_addr = 28 | let cst = init_client_proxy int_serializer caddr kvs_addr in 29 | run cst transaction3 30 | 31 | let server srv = 32 | init_server int_serializer srv -------------------------------------------------------------------------------- /ml_sources/examples/transactional_consistency/snapshot_isolation/examples/deprecated/classical_example_run/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name classical_example_run_code) 3 | (flags :standard -rectypes) 4 | (libraries client_server_code snapshot_isolation_code util_code aneris)) 5 | -------------------------------------------------------------------------------- /ml_sources/examples/transactional_consistency/snapshot_isolation/examples/deprecated/disjoint_reads/disjoint_reads_code.ml: -------------------------------------------------------------------------------- 1 | open !Ast 2 | open Serialization_code 3 | open Snapshot_isolation_code 4 | open Util_code 5 | 6 | let transaction1 cst = 7 | start cst; 8 | write cst "x" 1; 9 | commitT cst 10 | 11 | let transaction2 cst = 12 | start cst; 13 | write cst "y" 2; 14 | commitT cst 15 | 16 | let transaction3 cst = 17 | start cst; 18 | let vx = read cst "x" in 19 | let vy = read cst "y" in 20 | commitT cst 21 | 22 | let transaction1_client caddr kvs_addr = 23 | let cst = init_client_proxy int_serializer caddr kvs_addr in 24 | transaction1 cst 25 | 26 | let transaction2_client caddr kvs_addr = 27 | let cst = init_client_proxy int_serializer caddr kvs_addr in 28 | transaction2 cst 29 | 30 | let transaction3_client caddr kvs_addr = 31 | let cst = init_client_proxy int_serializer caddr kvs_addr in 32 | transaction3 cst 33 | 34 | let server srv = 35 | init_server int_serializer srv 36 | -------------------------------------------------------------------------------- /ml_sources/examples/transactional_consistency/snapshot_isolation/examples/deprecated/disjoint_reads/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name disjoint_reads_code) 3 | (flags :standard -rectypes) 4 | (libraries client_server_code snapshot_isolation_code util_code aneris)) 5 | -------------------------------------------------------------------------------- /ml_sources/examples/transactional_consistency/snapshot_isolation/examples/deprecated/read_your_writes/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name read_your_writes_code) 3 | (flags :standard -rectypes) 4 | (libraries client_server_code snapshot_isolation_code util_code aneris)) 5 | -------------------------------------------------------------------------------- /ml_sources/examples/transactional_consistency/snapshot_isolation/examples/deprecated/read_your_writes/read_your_writes_code.ml: -------------------------------------------------------------------------------- 1 | open !Ast 2 | open Serialization_code 3 | open Snapshot_isolation_code 4 | open Util_code 5 | 6 | let transaction cst = 7 | start cst; 8 | write cst "x" 1; 9 | let vx = read cst "x" in 10 | assert (vx = Some 1); 11 | commitU cst 12 | 13 | let transaction_client caddr kvs_addr = 14 | let cst = init_client_proxy int_serializer caddr kvs_addr in 15 | transaction cst 16 | 17 | let server srv = 18 | init_server int_serializer srv 19 | -------------------------------------------------------------------------------- /ml_sources/examples/transactional_consistency/snapshot_isolation/examples/disjoint_writes/disjoint_writes_code.ml: -------------------------------------------------------------------------------- 1 | open !Ast 2 | open Serialization_code 3 | open Snapshot_isolation_code 4 | open Util_code 5 | 6 | (* Transactions that write to different keys can commit simultaneously *) 7 | 8 | let transaction1 cst = 9 | start cst; 10 | write cst "x" 1; 11 | commitT cst 12 | 13 | let transaction2 cst = 14 | start cst; 15 | write cst "y" 1; 16 | commitT cst 17 | 18 | let transaction1_client caddr kvs_addr = 19 | let cst = init_client_proxy int_serializer caddr kvs_addr in 20 | transaction1 cst 21 | 22 | let transaction2_client caddr kvs_addr = 23 | let cst = init_client_proxy int_serializer caddr kvs_addr in 24 | transaction2 cst 25 | 26 | let server srv = 27 | init_server int_serializer srv 28 | -------------------------------------------------------------------------------- /ml_sources/examples/transactional_consistency/snapshot_isolation/examples/disjoint_writes/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name disjoint_writes_code) 3 | (flags :standard -rectypes) 4 | (libraries client_server_code snapshot_isolation_code util_code aneris)) 5 | -------------------------------------------------------------------------------- /ml_sources/examples/transactional_consistency/snapshot_isolation/examples/function_call/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name function_call_code) 3 | (flags :standard -rectypes) 4 | (libraries client_server_code snapshot_isolation_code util_code aneris)) 5 | -------------------------------------------------------------------------------- /ml_sources/examples/transactional_consistency/snapshot_isolation/examples/function_call/function_call_code.ml: -------------------------------------------------------------------------------- 1 | open !Ast 2 | open Serialization_code 3 | open Snapshot_isolation_code 4 | open Util_code 5 | 6 | let transaction1 cst = 7 | start cst; 8 | write cst "x" 42; 9 | commitU cst 10 | 11 | let transaction2 cst f = 12 | start cst; 13 | let r = f cst "x" in 14 | write cst "y" r; 15 | commitU cst 16 | 17 | let transaction1_client caddr kvs_addr = 18 | let cst = init_client_proxy int_serializer caddr kvs_addr in 19 | transaction1 cst 20 | 21 | let transaction2_client caddr kvs_addr f = 22 | let cst = init_client_proxy int_serializer caddr kvs_addr in 23 | transaction2 cst f 24 | 25 | let server srv = 26 | init_server int_serializer srv 27 | -------------------------------------------------------------------------------- /ml_sources/examples/transactional_consistency/snapshot_isolation/examples/no_serializability/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name no_serializability_code) 3 | (flags :standard -rectypes) 4 | (libraries client_server_code snapshot_isolation_code util_code aneris)) 5 | -------------------------------------------------------------------------------- /ml_sources/examples/transactional_consistency/snapshot_isolation/examples/no_serializability/no_serializability_code.ml: -------------------------------------------------------------------------------- 1 | open !Ast 2 | open Serialization_code 3 | open Network_util_code 4 | open Snapshot_isolation_code 5 | open Util_code 6 | 7 | let transaction1 cst = 8 | start cst; 9 | write cst "x" 1; 10 | write cst "y" 1; 11 | write cst "z" 1; 12 | commitU cst 13 | 14 | let transaction2 cst = 15 | wait_transaction cst (fun v -> v = 1) "z"; 16 | start cst; 17 | let vx = read cst "x" in 18 | if vx = Some 1 then 19 | write cst "y" (-1); 20 | commitU cst 21 | 22 | let transaction3 cst = 23 | wait_transaction cst (fun v -> v = 1) "z"; 24 | start cst; 25 | let vy = read cst "y" in 26 | if vy = Some 1 then 27 | write cst "x" (-1); 28 | commitU cst 29 | 30 | let transaction4 cst = 31 | wait_transaction cst (fun v -> v = 1) "z"; 32 | start cst; 33 | let vx = unSOME (read cst "x") in 34 | let vy = unSOME (read cst "y") in 35 | let r = vx + vy in 36 | (* The case r = -2 would not happen in case of serializability *) 37 | assert (r = -2 || 0 <= r); 38 | commitU cst 39 | 40 | let transaction1_client caddr kvs_addr = 41 | let cst = init_client_proxy int_serializer caddr kvs_addr in 42 | transaction1 cst 43 | 44 | let transaction2_client caddr kvs_addr = 45 | let cst = init_client_proxy int_serializer caddr kvs_addr in 46 | transaction2 cst 47 | 48 | let transaction3_client caddr kvs_addr = 49 | let cst = init_client_proxy int_serializer caddr kvs_addr in 50 | transaction3 cst 51 | 52 | let transaction4_client caddr kvs_addr = 53 | let cst = init_client_proxy int_serializer caddr kvs_addr in 54 | transaction4 cst 55 | 56 | let server srv = 57 | init_server int_serializer srv 58 | -------------------------------------------------------------------------------- /ml_sources/examples/transactional_consistency/snapshot_isolation/examples/non_repeatable_read/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name non_repeatable_read_code) 3 | (flags :standard -rectypes) 4 | (libraries client_server_code snapshot_isolation_code util_code aneris)) 5 | -------------------------------------------------------------------------------- /ml_sources/examples/transactional_consistency/snapshot_isolation/examples/non_repeatable_read/non_repeatable_read_code.ml: -------------------------------------------------------------------------------- 1 | open !Ast 2 | open Serialization_code 3 | open Snapshot_isolation_code 4 | open Util_code 5 | 6 | let transaction1 cst = 7 | start cst; 8 | write cst "x" 1; 9 | commitT cst 10 | 11 | let transaction2 cst = 12 | start cst; 13 | let v1 = read cst "x" in 14 | let v2 = read cst "x" in 15 | assert (v1 = v2); 16 | commitT cst 17 | 18 | let transaction1_client caddr kvs_addr = 19 | let cst = init_client_proxy int_serializer caddr kvs_addr in 20 | transaction1 cst 21 | 22 | let transaction2_client caddr kvs_addr = 23 | let cst = init_client_proxy int_serializer caddr kvs_addr in 24 | transaction2 cst 25 | 26 | let server srv = 27 | init_server int_serializer srv 28 | -------------------------------------------------------------------------------- /ml_sources/examples/transactional_consistency/snapshot_isolation/examples/only_reads/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name only_reads_code) 3 | (flags :standard -rectypes) 4 | (libraries client_server_code snapshot_isolation_code util_code aneris)) 5 | -------------------------------------------------------------------------------- /ml_sources/examples/transactional_consistency/snapshot_isolation/examples/only_reads/only_reads_code.ml: -------------------------------------------------------------------------------- 1 | open !Ast 2 | open Serialization_code 3 | open Snapshot_isolation_code 4 | open Util_code 5 | 6 | let transaction1 cst = 7 | start cst; 8 | write cst "x" 1; 9 | commitU cst 10 | 11 | (* Read-only transactions will always commit *) 12 | let transaction2 cst = 13 | start cst; 14 | let _vx = read cst "x" in 15 | commitT cst 16 | 17 | let transaction1_client caddr kvs_addr = 18 | let cst = init_client_proxy int_serializer caddr kvs_addr in 19 | transaction1 cst 20 | 21 | let transaction2_client caddr kvs_addr = 22 | let cst = init_client_proxy int_serializer caddr kvs_addr in 23 | transaction2 cst 24 | 25 | let server srv = 26 | init_server int_serializer srv 27 | -------------------------------------------------------------------------------- /ml_sources/examples/transactional_consistency/snapshot_isolation/examples/read_skew/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name read_skew_code) 3 | (flags :standard -rectypes) 4 | (libraries client_server_code snapshot_isolation_code util_code aneris)) 5 | -------------------------------------------------------------------------------- /ml_sources/examples/transactional_consistency/snapshot_isolation/examples/read_skew/read_skew_code.ml: -------------------------------------------------------------------------------- 1 | open !Ast 2 | open Serialization_code 3 | open Snapshot_isolation_code 4 | open Util_code 5 | 6 | let transaction1 cst = 7 | start cst; 8 | write cst "x" 1; 9 | write cst "y" 1; 10 | commitT cst 11 | 12 | let transaction2 cst = 13 | start cst; 14 | let vx = read cst "x" in 15 | let vy = read cst "y" in 16 | assert (vx = vy); 17 | commitT cst 18 | 19 | let transaction1_client caddr kvs_addr = 20 | let cst = init_client_proxy int_serializer caddr kvs_addr in 21 | transaction1 cst 22 | 23 | let transaction2_client caddr kvs_addr = 24 | let cst = init_client_proxy int_serializer caddr kvs_addr in 25 | transaction2 cst 26 | 27 | let server srv = 28 | init_server int_serializer srv 29 | -------------------------------------------------------------------------------- /ml_sources/examples/transactional_consistency/snapshot_isolation/examples/sequential_writes/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name sequential_writes_code) 3 | (flags :standard -rectypes) 4 | (libraries client_server_code snapshot_isolation_code util_code aneris)) 5 | -------------------------------------------------------------------------------- /ml_sources/examples/transactional_consistency/snapshot_isolation/examples/sequential_writes/sequential_writes_code.ml: -------------------------------------------------------------------------------- 1 | open !Ast 2 | open Serialization_code 3 | open Snapshot_isolation_code 4 | open Util_code 5 | 6 | (* Sequential writes will always commit *) 7 | 8 | let transaction1 cst = 9 | start cst; 10 | write cst "x" 1; 11 | commitT cst 12 | 13 | let transaction2 cst = 14 | wait_transaction cst (fun v -> v = 1) "x"; 15 | start cst; 16 | write cst "x" 2; 17 | commitT cst 18 | 19 | let transaction1_client caddr kvs_addr = 20 | let cst = init_client_proxy int_serializer caddr kvs_addr in 21 | transaction1 cst 22 | 23 | let transaction2_client caddr kvs_addr = 24 | let cst = init_client_proxy int_serializer caddr kvs_addr in 25 | transaction2 cst 26 | 27 | let server srv = 28 | init_server int_serializer srv 29 | -------------------------------------------------------------------------------- /ml_sources/examples/transactional_consistency/snapshot_isolation/examples/write_skew/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name write_skew_code) 3 | (flags :standard -rectypes) 4 | (libraries client_server_code snapshot_isolation_code util_code aneris)) 5 | -------------------------------------------------------------------------------- /ml_sources/examples/transactional_consistency/snapshot_isolation/examples/write_skew/write_skew_code.ml: -------------------------------------------------------------------------------- 1 | open !Ast 2 | open Serialization_code 3 | open Snapshot_isolation_code 4 | open Util_code 5 | 6 | let transaction1 cst = 7 | start cst; 8 | let vy = read cst "y" in 9 | write cst "x" 1; 10 | commitT cst 11 | 12 | let transaction2 cst = 13 | start cst; 14 | let vx = read cst "x" in 15 | write cst "y" 1; 16 | commitT cst 17 | 18 | let transaction1_client caddr kvs_addr = 19 | let cst = init_client_proxy int_serializer caddr kvs_addr in 20 | transaction1 cst 21 | 22 | let transaction2_client caddr kvs_addr = 23 | let cst = init_client_proxy int_serializer caddr kvs_addr in 24 | transaction2 cst 25 | 26 | let server srv = 27 | init_server int_serializer srv 28 | -------------------------------------------------------------------------------- /ml_sources/examples/transactional_consistency/snapshot_isolation/snapshot_isolation_code.mli: -------------------------------------------------------------------------------- 1 | 2 | open Ast 3 | type 'a connection_state 4 | 5 | val init_server : 'a serializer -> saddr -> unit 6 | val start : 'a connection_state -> unit 7 | val read : 'a connection_state -> string -> 'a option 8 | val write : 'a connection_state -> string -> 'a -> unit 9 | val commit : 'a connection_state -> bool 10 | val init_client_proxy : 'a serializer -> saddr -> saddr -> 'a connection_state 11 | -------------------------------------------------------------------------------- /ml_sources/examples/transactional_consistency/snapshot_isolation/util/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name util_code) 3 | (flags :standard -rectypes) 4 | (libraries client_server_code snapshot_isolation_code aneris)) 5 | -------------------------------------------------------------------------------- /ml_sources/examples/transactional_consistency/snapshot_isolation/util/util_code.ml: -------------------------------------------------------------------------------- 1 | open !Ast 2 | open Serialization_code 3 | open Snapshot_isolation_code 4 | 5 | let commitU cst : unit = 6 | let _b = commit cst in () 7 | 8 | let commitT cst : unit = 9 | assert (commit cst) 10 | 11 | let wait_transaction (cst : 'a connection_state) 12 | (cond : 'a -> bool) (k : string) : unit = 13 | let rec aux () = 14 | start cst; 15 | match read cst k with 16 | | None -> 17 | commitT cst; aux () 18 | | Some v -> 19 | if cond v 20 | then (commitT cst) 21 | else (commitT cst; aux ()) 22 | in aux () 23 | 24 | let weak_wait_transaction (cst : 'a connection_state) 25 | (cond : 'a -> bool) (k : string) : unit = 26 | start cst; 27 | let rec aux () = 28 | match read cst k with 29 | | None -> aux () 30 | | Some v -> 31 | if cond v 32 | then commitU cst 33 | else aux () 34 | in aux () 35 | 36 | let run (cst : 'a connection_state) 37 | (handler : 'a connection_state -> unit) : bool = 38 | start cst; 39 | handler cst; 40 | commit cst 41 | 42 | let run_client caddr kvs_addr tbody = 43 | unsafe (fun () -> Printf.printf "Start client.\n%!"); 44 | let cst = init_client_proxy int_serializer caddr kvs_addr in 45 | unsafe (fun () -> Printf.printf "Client started.\n%!"); 46 | let b = run cst tbody in 47 | unsafe (fun () -> Printf.printf "Transaction %s.\n%!" 48 | (if b then "committed" else "aborted")) 49 | 50 | let rec loop () = loop () 51 | 52 | let unSOME o = match o with 53 | None -> assert false 54 | | Some x -> x -------------------------------------------------------------------------------- /ml_sources/examples/viewstamped_replication/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (wrapped false) 3 | (name vr) 4 | (flags :standard -rectypes) 5 | (libraries aneris)) -------------------------------------------------------------------------------- /ml_sources/examples/viewstamped_replication/examples/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name observe_par_sc2) 3 | (flags :standard -rectypes) 4 | (libraries vr aneris)) -------------------------------------------------------------------------------- /ml_sources/examples/viewstamped_replication/examples/run.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | 4 | EXE="~/repositories/aneris/aneris-examples/_build/default/ml_sources/viewstamped_replication/examples/observe_par_sc2.exe" 5 | 6 | RUN () { 7 | osascript -e 'tell app "Terminal" to do script "'"${EXE//\"/\\\"} ${1//\"/\\\"} ${2//\"/\\\"}"'"' 8 | } 9 | 10 | cd ~/repositories/aneris/aneris-examples 11 | 12 | dune build 13 | 14 | cd ~/repositories/aneris/aneris-examples/ml_sources/viewstamped_replication/examples 15 | 16 | RUN r4 17 | RUN r3 18 | RUN r2 19 | RUN r1 20 | RUN r0 21 | RUN cl 22 | -------------------------------------------------------------------------------- /ml_sources/examples/viewstamped_replication/vr_client_proxy_code.ml: -------------------------------------------------------------------------------- 1 | open Ast 2 | open List_code 3 | open Network_util_code 4 | open Vr_serialization_code 5 | 6 | (* TODO: check and explain the code. *) 7 | let wait_for_reply (val_ser[@metavar]) len saddrl sh reqId prmId reqMsg = 8 | let rid = !reqId in 9 | let rec aux () = 10 | match receiveFrom sh with 11 | None -> 12 | sendto_all_set sh saddrl reqMsg; 13 | aux () 14 | | Some rply -> 15 | let repl = (reply_serializer val_ser).s_deser (fst rply) in 16 | let (((v, resId), res), _caddr) = repl in 17 | assert (resId <= rid); 18 | if resId = rid 19 | then 20 | begin 21 | prmId := v mod len; 22 | reqId := rid + 1; 23 | res 24 | end 25 | else aux () 26 | in aux () 27 | 28 | let make_request (val_ser[@metavar]) len saddrl caddr sh lock reqId prmId = 29 | let request req = 30 | (* Use lock to prevent client to run requests in parallel. *) 31 | acquire lock; 32 | let dst = unSOME (list_nth saddrl !prmId) in 33 | let reqMsg = (request_serializer val_ser).s_ser (((req, caddr), !reqId)) in 34 | ignore(sendTo sh reqMsg dst); 35 | unsafe (fun () -> Printf.eprintf "made request: %s\n%!" (reqMsg)); 36 | let r = wait_for_reply val_ser len saddrl sh reqId prmId reqMsg in 37 | release lock; r 38 | in 39 | let wr k v = 40 | let _req = request (InjL (k, v)) in () in 41 | let rd k = 42 | request (InjR k) in 43 | (wr, rd) 44 | 45 | (* TODO: check and explain the code. *) 46 | let install_proxy (val_ser[@metavar]) saddrl caddr = 47 | let sh = udp_socket () in 48 | let lock = newlock () in 49 | let prmId = ref 0 in 50 | let reqId = ref 0 in 51 | let len = list_length saddrl in 52 | setReceiveTimeout sh 3 0; 53 | socketBind sh caddr; 54 | make_request val_ser len saddrl caddr sh lock reqId prmId 55 | -------------------------------------------------------------------------------- /ml_sources/examples/viewstamped_replication/vr_debug.ml: -------------------------------------------------------------------------------- 1 | open Ast 2 | 3 | let int_log_to_string l = 4 | let rec aux l = match l with 5 | | None -> [] 6 | | Some (h, tl) -> 7 | let ((op, addr), seqid) = h in 8 | let i = string_of_int seqid in 9 | let p = string_of_int (port_of_address addr) in 10 | match op with 11 | | InjL (s, r) -> 12 | let r = string_of_int r in 13 | let elt = "{cl:" ^ p ^ ", id:" ^ i ^ ", wr:" ^ s ^ " " ^ r ^ "}" in 14 | elt :: aux tl 15 | | InjR s -> 16 | let p = string_of_int (port_of_address addr) in 17 | let elt = "{cl:" ^ p ^ ", id:" ^ i ^ ", rd" ^ s ^ "}" in 18 | elt :: aux tl 19 | in 20 | String.concat ", " (aux l) 21 | 22 | 23 | let print_first_line () = 24 | Printf.eprintf " Event | View | View mod i | Normal Mode | Op-Num | Commit-Num | \n%!" 25 | 26 | let print_step_state _i ev vi prot prim opN cmtN _log () = 27 | Printf.eprintf "-----------------------------------------------------------------\n%!"; 28 | Printf.eprintf "%-12s | %-4d | %-10d | %-11b | %-6d | %-10d | \n%!" 29 | ev vi prim prot opN cmtN 30 | (* (int_log_to_string log) *) 31 | 32 | let print_step_state_vc _i ev vi prot prim opN cmtN _log sv dv () = 33 | Printf.eprintf "-----------------------------------------------------------------\n%!"; 34 | Printf.eprintf "%-12s | %-4d | %-10d | %-11b | %-6d | %-10d | %-7d | %-7d \n%!" 35 | ev vi prim prot opN cmtN sv dv 36 | (* (int_log_to_string log) *) 37 | --------------------------------------------------------------------------------