From bd87891111a68678aa0dfb26bfac522fcf979486 Mon Sep 17 00:00:00 2001 From: Mathieu Barbin Date: Sat, 28 Dec 2024 12:22:30 +0100 Subject: [PATCH] Reduce dependencies --- bopkit-tests.opam | 1 - bopkit.opam | 2 - dune-project | 20 --------- lib/bit_utils/test/dune | 22 +++++++--- lib/bit_utils/test/test__bit_array.ml | 14 +++---- lib/bit_utils/test/test__bit_counter.ml | 2 +- lib/bit_utils/test/test__bit_matrix.ml | 27 +++++++----- .../test/test__bit_string_encoding.ml | 7 +++- lib/bit_utils/test/test__partial_bit.ml | 19 ++++++--- lib/bit_utils/test/test__partial_bit_array.ml | 42 +++++++++++++++---- .../test/test__partial_bit_matrix.ml | 12 +++--- lib/bopkit_block/src/bopkit_block.ml | 28 ++++++++----- lib/bopkit_block/src/dune | 4 +- lib/bopkit_simulator/src/bopkit_simulator.ml | 4 +- lib/bopkit_simulator/src/circuit_simulator.ml | 34 +++++++-------- lib/bopkit_simulator/src/dune | 3 +- lib/bopkit_sleeper/src/bopkit_sleeper.ml | 21 ++++------ lib/bopkit_sleeper/src/dune | 4 +- project/subleq/circuit/disk_interface.ml | 13 +++--- project/subleq/circuit/dune | 1 - project/subleq/circuit/subleq_ram.ml | 13 +++--- project/visa/lib/visa_simulator/src/dune | 5 +-- .../lib/visa_simulator/src/visa_simulator.ml | 12 +++--- .../src/cmd_digital_calendar_gen_input.ml | 6 +-- .../src/cmd_digital_calendar_gen_raw_input.ml | 6 +-- .../src/cmd_digital_calendar_map_raw_input.ml | 4 +- .../src/cmd_digital_watch_gen_input.ml | 9 ++-- stdlib/7-segment/src/dune | 14 +------ stdlib/7-segment/src/seven_segment_display.ml | 2 +- stdlib/bopboard/src/bopboard.ml | 13 ++++-- stdlib/bopboard/src/dune | 2 - stdlib/memories/bin/dune | 1 - stdlib/memories/bin/ram_memory.ml | 13 +++--- subleq.opam | 1 - visa.opam | 1 - 35 files changed, 198 insertions(+), 184 deletions(-) diff --git a/bopkit-tests.opam b/bopkit-tests.opam index a625dbd7..fe9a7d2e 100644 --- a/bopkit-tests.opam +++ b/bopkit-tests.opam @@ -23,7 +23,6 @@ depends: [ "cmdliner" {>= "1.3.0"} "comments-parser" {>= "0.2.2"} "core" {>= "v0.17" & < "v0.18"} - "core_unix" {>= "v0.17" & < "v0.18"} "dune-site" {>= "3.17"} "expect_test_helpers_core" {>= "v0.17" & < "v0.18"} "fpath" {>= "0.7.3"} diff --git a/bopkit.opam b/bopkit.opam index 62320bd1..931b917a 100644 --- a/bopkit.opam +++ b/bopkit.opam @@ -21,8 +21,6 @@ depends: [ "cmdliner" {>= "1.3.0"} "comments-parser" {>= "0.2.2"} "core" {>= "v0.17" & < "v0.18"} - "core_kernel" {>= "v0.17" & < "v0.18"} - "core_unix" {>= "v0.17" & < "v0.18"} "dune-site" {>= "3.17"} "fpath" {>= "0.7.3"} "fpath-base" {>= "0.2.2"} diff --git a/dune-project b/dune-project index ca0836e4..4ba4c0fe 100644 --- a/dune-project +++ b/dune-project @@ -63,14 +63,6 @@ (and (>= v0.17) (< v0.18))) - (core_kernel - (and - (>= v0.17) - (< v0.18))) - (core_unix - (and - (>= v0.17) - (< v0.18))) (dune-site (>= 3.17)) (fpath @@ -174,10 +166,6 @@ (and (>= v0.17) (< v0.18))) - (core_unix - (and - (>= v0.17) - (< v0.18))) (dune-site (>= 3.17)) (fpath @@ -277,10 +265,6 @@ (and (>= v0.17) (< v0.18))) - (core_unix - (and - (>= v0.17) - (< v0.18))) (dune-site (>= 3.17)) (fpath @@ -386,10 +370,6 @@ (and (>= v0.17) (< v0.18))) - (core_unix - (and - (>= v0.17) - (< v0.18))) (dune-site (>= 3.17)) (expect_test_helpers_core diff --git a/lib/bit_utils/test/dune b/lib/bit_utils/test/dune index 19d764c9..a341cc43 100644 --- a/lib/bit_utils/test/dune +++ b/lib/bit_utils/test/dune @@ -1,14 +1,26 @@ (library (name bit_utils_test) (public_name bopkit-tests.bit_utils_test) - (flags :standard -w +a-4-40-41-42-44-45-48-66 -warn-error +a -open Core) + (flags + :standard + -w + +a-4-40-41-42-44-45-48-66 + -warn-error + +a + -open + Base + -open + Stdio + -open + Expect_test_helpers_base) (libraries + base bit_utils - core - core_unix - core_unix.filename_unix expect_test_helpers_core - fpath) + expect_test_helpers_core.expect_test_helpers_base + fpath + stdio + unix) (inline_tests) (lint (pps ppx_js_style -check-doc-comments)) diff --git a/lib/bit_utils/test/test__bit_array.ml b/lib/bit_utils/test/test__bit_array.ml index 500d43bc..04f4b8c6 100644 --- a/lib/bit_utils/test/test__bit_array.ml +++ b/lib/bit_utils/test/test__bit_array.ml @@ -25,7 +25,7 @@ let%expect_test "to_string" = [%expect {||}]; test [| true; false |]; [%expect {| 10 |}]; - test (Array.init 10 ~f:(fun i -> i mod 2 = 0)); + test (Array.init 10 ~f:(fun i -> i % 2 = 0)); [%expect {| 1010101010 |}] ;; @@ -43,7 +43,7 @@ let%expect_test "to_string roundtrip" = let%expect_test "text files" = let test t = - let path = Filename_unix.temp_file "test__bit_array" "text" |> Fpath.v in + let path = Stdlib.Filename.temp_file "test__bit_array" "text" |> Fpath.v in Bit_array.to_text_file t ~path; let contents = In_channel.read_all (path |> Fpath.to_string) in let t2 = Bit_array.of_text_file ~path in @@ -55,13 +55,13 @@ let%expect_test "text files" = raise_s [%sexp "String contents not equal", { contents : string; contents2 : string }]; print_endline contents; - Core_unix.unlink (path |> Fpath.to_string) + Unix.unlink (path |> Fpath.to_string) in test [||]; [%expect {||}]; test [| true; true; false |]; [%expect {| 110 |}]; - test (Array.init 64 ~f:(fun i -> i mod 2 = 1)); + test (Array.init 64 ~f:(fun i -> i % 2 = 1)); [%expect {| 0101010101010101010101010101010101010101010101010101010101010101 |}]; () ;; @@ -88,7 +88,7 @@ let%expect_test "to_signed_int / to_int" = ~f:(fun t -> let len = Array.length t in let modulo = Int.pow 2 len in - let is_negative = len > 0 && t.(pred len) in + let is_negative = len > 0 && t.(Int.pred len) in let signed_int = Bit_array.to_signed_int t in let int = Bit_array.to_int t in let expected_signed_int = if is_negative then int - modulo else int in @@ -108,7 +108,7 @@ let%expect_test "sequence" = let j = Bit_array.to_int t in if i <> j then raise_s [%sexp "Unexpected int", { t : Bit_array.t; i : int; j : int }]; let signed = Bit_array.to_signed_int t in - Printf.printf "%s | %02d | %02d\n" (Bit_array.to_string t) i signed + print_endline (Printf.sprintf "%s | %02d | %02d" (Bit_array.to_string t) i signed) done; [%expect {| @@ -161,7 +161,7 @@ let%expect_test "blit_init" = (* Check that [f] is called from left to right. *) assert (i = !last + 1); last := i; - i mod 2 = 0); + i % 2 = 0); print_endline (Bit_array.to_string t); [%expect {| 1010101010 |}] ;; diff --git a/lib/bit_utils/test/test__bit_counter.ml b/lib/bit_utils/test/test__bit_counter.ml index ce1299f5..1099fb7c 100644 --- a/lib/bit_utils/test/test__bit_counter.ml +++ b/lib/bit_utils/test/test__bit_counter.ml @@ -28,7 +28,7 @@ let%expect_test "counter" = ;; let%expect_test "counter" = - let t = Array.init 10 ~f:(fun i -> i mod 2 = 1) in + let t = Array.init 10 ~f:(fun i -> i % 2 = 1) in let bit_counter = Bit_counter.create ~len:2 in for _ = 0 to 9 do Bit_counter.blit_next_value bit_counter ~dst:t ~dst_pos:5; diff --git a/lib/bit_utils/test/test__bit_matrix.ml b/lib/bit_utils/test/test__bit_matrix.ml index 869b4ad8..74227e58 100644 --- a/lib/bit_utils/test/test__bit_matrix.ml +++ b/lib/bit_utils/test/test__bit_matrix.ml @@ -1,12 +1,17 @@ let%expect_test "init" = let test t = print_s [%sexp (t : Bit_matrix.t)] in - test (Bit_matrix.init_matrix_linear ~dimx:0 ~dimy:0 ~f:(const false)); + test (Bit_matrix.init_matrix_linear ~dimx:0 ~dimy:0 ~f:(Fn.const false)); [%expect {| () |}]; - test (Bit_matrix.init_matrix_linear ~dimx:0 ~dimy:3 ~f:(const false)); + test (Bit_matrix.init_matrix_linear ~dimx:0 ~dimy:3 ~f:(Fn.const false)); [%expect {| () |}]; - test (Bit_matrix.init_matrix_linear ~dimx:3 ~dimy:0 ~f:(const false)); - [%expect {| (() () ()) |}]; - let t = Bit_matrix.init_matrix_linear ~dimx:3 ~dimy:5 ~f:(fun i -> i mod 2 = 1) in + test (Bit_matrix.init_matrix_linear ~dimx:3 ~dimy:0 ~f:(Fn.const false)); + [%expect + {| + (() + () + ()) + |}]; + let t = Bit_matrix.init_matrix_linear ~dimx:3 ~dimy:5 ~f:(fun i -> i % 2 = 1) in Bit_matrix.to_text_channel t stdout; [%expect {| @@ -16,7 +21,7 @@ let%expect_test "init" = ;; let%expect_test "of_bit_array" = - let bit_array = Array.init 24 ~f:(fun i -> i mod 2 = 1) in + let bit_array = Array.init 24 ~f:(fun i -> i % 2 = 1) in let test t = Bit_matrix.to_text_channel t stdout in (* Shorter than input *) test (Bit_matrix.of_bit_array ~dimx:2 ~dimy:6 bit_array); @@ -42,11 +47,11 @@ let%expect_test "of_bit_array" = ;; let%expect_test "of_text_file" = - let path = Filename_unix.temp_file "test__bit_matrix" "text" |> Fpath.v in + let path = Stdlib.Filename.temp_file "test__bit_matrix" "text" |> Fpath.v in Out_channel.with_file (path |> Fpath.to_string) ~f:(fun oc -> - Printf.fprintf oc "// Hello comment\n"; - Printf.fprintf oc "010101010101\n"; - Printf.fprintf oc "011111111110\n"); + Out_channel.output_string oc "// Hello comment\n"; + Out_channel.output_string oc "010101010101\n"; + Out_channel.output_string oc "011111111110\n"); let test ~dimx ~dimy = let t = Bit_matrix.of_text_file ~dimx ~dimy ~path in Bit_matrix.to_text_channel t stdout @@ -69,6 +74,6 @@ let%expect_test "of_text_file" = 0101 0101 0111 |}]; - Core_unix.unlink (path |> Fpath.to_string); + Unix.unlink (path |> Fpath.to_string); () ;; diff --git a/lib/bit_utils/test/test__bit_string_encoding.ml b/lib/bit_utils/test/test__bit_string_encoding.ml index fb2c84ef..7aab49fe 100644 --- a/lib/bit_utils/test/test__bit_string_encoding.ml +++ b/lib/bit_utils/test/test__bit_string_encoding.ml @@ -14,8 +14,11 @@ let%expect_test "T encoding" = print_s [%sexp { t : T.t; char : Char.t }]); [%expect {| - ((t false) (char 0)) - ((t true) (char 1)) |}] + ((t false) + (char 0)) + ((t true) + (char 1)) + |}] ;; let%expect_test "T_opt encoding" = diff --git a/lib/bit_utils/test/test__partial_bit.ml b/lib/bit_utils/test/test__partial_bit.ml index 65d4c1c4..6497d1ce 100644 --- a/lib/bit_utils/test/test__partial_bit.ml +++ b/lib/bit_utils/test/test__partial_bit.ml @@ -9,17 +9,24 @@ end let%expect_test "conflicts" = List.iter T_opt.all ~f:(fun t_opt -> List.iter T.all ~f:(fun t -> - Printf.printf - "%c conflicts with:%c => %b\n" - (Bit_string_encoding.Bit_option.to_char t_opt) - (Bit_string_encoding.Bit.to_char t) - (Partial_bit.conflicts t_opt ~with_:t))); + print_endline + (Printf.sprintf + "%c conflicts with:%c => %b\n" + (Bit_string_encoding.Bit_option.to_char t_opt) + (Bit_string_encoding.Bit.to_char t) + (Partial_bit.conflicts t_opt ~with_:t)))); [%expect {| * conflicts with:0 => false + * conflicts with:1 => false + 0 conflicts with:0 => false + 0 conflicts with:1 => true + 1 conflicts with:0 => true - 1 conflicts with:1 => false |}] + + 1 conflicts with:1 => false + |}] ;; diff --git a/lib/bit_utils/test/test__partial_bit_array.ml b/lib/bit_utils/test/test__partial_bit_array.ml index 1ff83823..288a6a49 100644 --- a/lib/bit_utils/test/test__partial_bit_array.ml +++ b/lib/bit_utils/test/test__partial_bit_array.ml @@ -6,13 +6,37 @@ let%expect_test "of_01star_chars_in_string" = test ""; [%expect {| () |}]; test "010"; - [%expect {| ((false) (true) (false)) |}]; + [%expect + {| + ((false) + (true) + (false)) + |}]; test "010\n"; - [%expect {| ((false) (true) (false)) |}]; + [%expect + {| + ((false) + (true) + (false)) + |}]; test "//010 and some other characters followed by 11"; - [%expect {| ((false) (true) (false) (true) (true)) |}]; + [%expect + {| + ((false) + (true) + (false) + (true) + (true)) + |}]; test "*010*\n"; - [%expect {| (() (false) (true) (false) ()) |}] + [%expect + {| + (() + (false) + (true) + (false) + ()) + |}] ;; let%expect_test "to_string" = @@ -21,7 +45,7 @@ let%expect_test "to_string" = [%expect {||}]; test [| Some true; Some false; None |]; [%expect {| 10* |}]; - test (Array.init 10 ~f:(fun i -> if i mod 2 = 0 then Some (i mod 3 = 0) else None)); + test (Array.init 10 ~f:(fun i -> if i % 2 = 0 then Some (i % 3 = 0) else None)); [%expect {| 1*0*0*1*0* |}] ;; @@ -44,7 +68,7 @@ let%expect_test "to_string roundtrip" = let%expect_test "text files" = let test t = - let path = Filename_unix.temp_file "test__bit_array" "text" |> Fpath.v in + let path = Stdlib.Filename.temp_file "test__bit_array" "text" |> Fpath.v in Partial_bit_array.to_text_file t ~path; let contents = In_channel.read_all (path |> Fpath.to_string) in let t2 = Partial_bit_array.of_text_file ~path in @@ -60,13 +84,13 @@ let%expect_test "text files" = raise_s [%sexp "String contents not equal", { contents : string; contents2 : string }]; print_endline contents; - Core_unix.unlink (path |> Fpath.to_string) + Unix.unlink (path |> Fpath.to_string) in test [||]; [%expect {||}]; test [| Some true; Some true; None; Some false |]; [%expect {| 11*0 |}]; - test (Array.init 64 ~f:(fun i -> if i mod 7 = 1 then None else Some (i mod 3 = 1))); + test (Array.init 64 ~f:(fun i -> if i % 7 = 1 then None else Some (i % 3 = 1))); [%expect {| 0*001001*010010*100100*001001*010010*100100*001001*010010*100100 |}]; () ;; @@ -78,7 +102,7 @@ let%expect_test "conflicts" = (Partial_bit_array.of_01star_chars_in_string a) ~with_:(Bit_array.of_01_chars_in_string b) in - Printf.printf "%S conflicts with:%S => %b\n" a b conflicts + print_endline (Printf.sprintf "%S conflicts with:%S => %b\n" a b conflicts) in test "" ""; [%expect {| "" conflicts with:"" => false |}]; diff --git a/lib/bit_utils/test/test__partial_bit_matrix.ml b/lib/bit_utils/test/test__partial_bit_matrix.ml index f224ffb2..bf453f4e 100644 --- a/lib/bit_utils/test/test__partial_bit_matrix.ml +++ b/lib/bit_utils/test/test__partial_bit_matrix.ml @@ -1,6 +1,6 @@ let%expect_test "of_partial_bit_array" = let partial_bit_array = - Array.init 24 ~f:(fun i -> if i mod 5 = 1 then None else Some (i mod 2 = 1)) + Array.init 24 ~f:(fun i -> if i % 5 = 1 then None else Some (i % 2 = 1)) in let test t = Partial_bit_matrix.to_text_channel t stdout in (* Shorter than input *) @@ -27,11 +27,11 @@ let%expect_test "of_partial_bit_array" = ;; let%expect_test "of_text_file" = - let path = Filename_unix.temp_file "test__bit_matrix" "text" |> Fpath.v in + let path = Stdlib.Filename.temp_file "test__bit_matrix" "text" |> Fpath.v in Out_channel.with_file (path |> Fpath.to_string) ~f:(fun oc -> - Printf.fprintf oc "// Hello comment\n"; - Printf.fprintf oc "010*010*01*1\n"; - Printf.fprintf oc "0**111*11110\n"); + Out_channel.output_string oc "// Hello comment\n"; + Out_channel.output_string oc "010*010*01*1\n"; + Out_channel.output_string oc "0**111*11110\n"); let test ~dimx ~dimy = let t = Partial_bit_matrix.of_text_file ~dimx ~dimy ~path in Partial_bit_matrix.to_text_channel t stdout @@ -54,6 +54,6 @@ let%expect_test "of_text_file" = 010* 01*1 0**1 |}]; - Core_unix.unlink (path |> Fpath.to_string); + Unix.unlink (path |> Fpath.to_string); () ;; diff --git a/lib/bopkit_block/src/bopkit_block.ml b/lib/bopkit_block/src/bopkit_block.ml index f6902211..fca9903d 100644 --- a/lib/bopkit_block/src/bopkit_block.ml +++ b/lib/bopkit_block/src/bopkit_block.ml @@ -265,6 +265,22 @@ let create ~name ~main ?(methods = []) ?(is_multi_threaded = false) () = { name; main; methods; is_multi_threaded } ;; +let rec retry_until_no_eintr f = + try f () with + | Unix.Unix_error (EINTR, _, _) -> retry_until_no_eintr f +;; + +let wait_for_stdin () = + retry_until_no_eintr (fun () -> + ignore + (UnixLabels.select + ~read:[ Unix.stdin ] + ~write:[] + ~except:[] + ~timeout:(-1. (* means `Never *)) + : Unix.file_descr list * Unix.file_descr list * Unix.file_descr list)) +;; + let main ?readme t_param = Command.make ~summary:"external block" @@ -312,17 +328,7 @@ let main ?readme t_param = if no_input then Some "" else ( - if is_multi_threaded - then - ignore - (Core_unix.select - ~restart:true - ~read:[ Core_unix.stdin ] - ~write:[] - ~except:[] - ~timeout:`Never - () - : Core_unix.Select_fds.t); + if is_multi_threaded then wait_for_stdin (); In_channel.input_line In_channel.stdin) with | None -> return (Ok ()) diff --git a/lib/bopkit_block/src/dune b/lib/bopkit_block/src/dune index d3f58adc..e5fb066d 100644 --- a/lib/bopkit_block/src/dune +++ b/lib/bopkit_block/src/dune @@ -23,8 +23,8 @@ cmdlang-cmdliner-runner cmdliner core - core_unix - stdio) + stdio + unix) (lint (pps ppx_js_style)) (preprocess diff --git a/lib/bopkit_simulator/src/bopkit_simulator.ml b/lib/bopkit_simulator/src/bopkit_simulator.ml index a06508a1..9a005c31 100644 --- a/lib/bopkit_simulator/src/bopkit_simulator.ml +++ b/lib/bopkit_simulator/src/bopkit_simulator.ml @@ -26,7 +26,7 @@ let run ~circuit ~config = Output_handler.output output_handler ~input ~output) in (* Make it possible to interrupt the simulation on sigint. *) - Sys_unix.catch_break true; + Stdlib.Sys.catch_break true; (try With_return.with_return (fun { return } -> match num_cycles with @@ -43,7 +43,7 @@ let run ~circuit ~config = | Quit -> return () done) with - | Sys_unix.Break | End_of_file -> ()); + | Stdlib.Sys.Break | End_of_file -> ()); Err.info [ Pp.textf "End of simulation (%S)" (circuit.path |> Fpath.to_string) ]; Circuit_simulator.quit circuit_simulator ;; diff --git a/lib/bopkit_simulator/src/circuit_simulator.ml b/lib/bopkit_simulator/src/circuit_simulator.ml index 6c53b50e..a13de612 100644 --- a/lib/bopkit_simulator/src/circuit_simulator.ml +++ b/lib/bopkit_simulator/src/circuit_simulator.ml @@ -101,7 +101,7 @@ let main t = t.circuit.main let init t = let () = - let env = Core_unix.environment () in + let env = Unix.environment () in let key = "PATH" in let path = Array.find_map env ~f:(fun s -> @@ -110,9 +110,7 @@ let init t = | None -> None) |> Option.value ~default:"" in - Core_unix.putenv - ~key - ~data:(String.concat ~sep:":" (Bopkit_sites.Sites.stdbin @ [ path ])) + Unix.putenv key (String.concat ~sep:":" (Bopkit_sites.Sites.stdbin @ [ path ])) in let external_blocks_table = Hashtbl.create (module String) in let external_processes : External_process.t Queue.t = Queue.create () in @@ -197,7 +195,7 @@ let init t = ~loc (lazy [ Pp.textf "Starting external process[%d] = '%s'." this_index command ]); Hashtbl.set external_blocks_table ~key:name ~data:this_index; - let output_pipe, input_pipe = Core_unix.open_process command in + let output_pipe, input_pipe = Unix.open_process command in let external_process = { External_process.loc ; command @@ -238,14 +236,13 @@ let init t = Err.info [ Pp.textf " Simulation <'%s'>" (main t).txt ] ;; -let or_exit_error e = - (match (e : Core_unix.Exit_or_signal.t) with - | Ok () -> Ok () - | Error (`Signal signal) -> - if Core.Signal.equal signal Core.Signal.int then Ok () else e - | Error (`Exit_non_zero _) -> e) - |> Core_unix.Exit_or_signal.or_error -;; +module Process_status = struct + type t = Unix.process_status = + | WEXITED of int + | WSIGNALED of int + | WSTOPPED of int + [@@deriving sexp_of] +end let quit t = let uncaught_exceptions = Queue.create () in @@ -254,11 +251,10 @@ let quit t = Err.debug ~loc:process.loc (lazy [ Pp.textf "Closing external process[%d] = '%s'." i process.command ]); - match - Core_unix.close_process (process.output_pipe, process.input_pipe) |> or_exit_error - with - | Ok () -> () - | Error e -> + match Unix.close_process (process.output_pipe, process.input_pipe) with + | WEXITED 0 -> () + | WSIGNALED s when s = Stdlib.Sys.sigint -> () + | process_status -> let loc = match process.pending_input with | None -> process.loc @@ -272,7 +268,7 @@ let quit t = (match process.pending_input with | None -> "" | Some { loc = _; input } -> Printf.sprintf "received: '%s' and " input) - ; Pp.textf "%s" (Error.to_string_hum e) + ; Pp.textf "%s" (Sexp.to_string_hum [%sexp (process_status : Process_status.t)]) ] | exception End_of_file -> Err.debug diff --git a/lib/bopkit_simulator/src/dune b/lib/bopkit_simulator/src/dune index f726c8c6..3f3535a5 100644 --- a/lib/bopkit_simulator/src/dune +++ b/lib/bopkit_simulator/src/dune @@ -21,12 +21,11 @@ bopkit_sites cmdlang core - core_unix - core_unix.sys_unix fpath loc pp pp-log.err + unix stdio) (lint (pps ppx_js_style -check-doc-comments)) diff --git a/lib/bopkit_sleeper/src/bopkit_sleeper.ml b/lib/bopkit_sleeper/src/bopkit_sleeper.ml index b1e814cf..7800f0a5 100644 --- a/lib/bopkit_sleeper/src/bopkit_sleeper.ml +++ b/lib/bopkit_sleeper/src/bopkit_sleeper.ml @@ -17,15 +17,14 @@ let create ~frequency ~as_if_started_at_midnight = (* Compute how many seconds have passed since this morning at midnight. *) let whattimeisit () = - let t = Caml_unix.localtime (Caml_unix.time ()) in - float_of_int ((t.tm_hour * 3600) + (t.tm_min * 60) + t.tm_sec) + let t = Unix.localtime (Unix.time ()) in + Float.of_int ((t.tm_hour * 3600) + (t.tm_min * 60) + t.tm_sec) ;; let start t = t.n <- 0; t.start - <- (Caml_unix.gettimeofday () - -. if t.as_if_started_at_midnight then whattimeisit () else 0.); + <- (Unix.gettimeofday () -. if t.as_if_started_at_midnight then whattimeisit () else 0.); t.started <- true ;; @@ -36,22 +35,18 @@ let wait ~(seconds : float) = (* This expression allows to wait for a number of seconds expressed as a float. *) ignore - (Caml_unix.select [] [] [] seconds - : Caml_unix.file_descr list - * Caml_unix.file_descr list - * Caml_unix.file_descr list) + (Unix.select [] [] [] seconds + : Unix.file_descr list * Unix.file_descr list * Unix.file_descr list) with - | Caml_unix.Unix_error (_, "select", _) -> ()) + | Unix.Unix_error (_, "select", _) -> ()) ;; let sleep t = if t.started then ( if t.n = Int.max_value then start t; - t.n <- succ t.n; - let advance = - t.start +. (float_of_int t.n *. t.period) -. Caml_unix.gettimeofday () - in + t.n <- Int.succ t.n; + let advance = t.start +. (Float.of_int t.n *. t.period) -. Unix.gettimeofday () in wait ~seconds:advance) else start t ;; diff --git a/lib/bopkit_sleeper/src/dune b/lib/bopkit_sleeper/src/dune index 6816cf3d..69f9a452 100644 --- a/lib/bopkit_sleeper/src/dune +++ b/lib/bopkit_sleeper/src/dune @@ -1,8 +1,8 @@ (library (name bopkit_sleeper) (public_name bopkit.sleeper) - (flags :standard -w +a-4-40-41-42-44-45-48-66 -warn-error +a -open Core) - (libraries core core_kernel.caml_unix core_unix) + (flags :standard -w +a-4-40-41-42-44-45-48-66 -warn-error +a -open Base) + (libraries base unix) (lint (pps ppx_js_style -check-doc-comments)) (preprocess diff --git a/project/subleq/circuit/disk_interface.ml b/project/subleq/circuit/disk_interface.ml index 76e7c480..a73550e6 100644 --- a/project/subleq/circuit/disk_interface.ml +++ b/project/subleq/circuit/disk_interface.ml @@ -22,12 +22,15 @@ let init ~architecture ~debug ~files_prefix ~number_of_programs = in if debug then ( - let (_ : Core_thread.t) = - Core_thread.create - ~on_uncaught_exn:`Kill_whole_process + let (_ : Thread.t) = + Thread.create (fun () -> - Bopkit_memory.event_loop mem ~read_only:true; - Stdlib.exit 0) + (match Bopkit_memory.event_loop mem ~read_only:true with + | () -> 0 + | exception e -> + prerr_endline (Exn.to_string e); + 1) + |> Stdlib.exit) () in Bopkit_memory.draw mem); diff --git a/project/subleq/circuit/dune b/project/subleq/circuit/dune index e0646da7..a2e7013b 100644 --- a/project/subleq/circuit/dune +++ b/project/subleq/circuit/dune @@ -16,7 +16,6 @@ bit_utils cmdlang core - core_unix.core_thread bopkit_block bopkit_sleeper fpath diff --git a/project/subleq/circuit/subleq_ram.ml b/project/subleq/circuit/subleq_ram.ml index 08e35450..e897db63 100644 --- a/project/subleq/circuit/subleq_ram.ml +++ b/project/subleq/circuit/subleq_ram.ml @@ -18,12 +18,15 @@ let init ~architecture ~cl ~debug = then ( Graphics.open_graph " 400x500"; Graphics.set_window_title "Subleq Internal RAM"; - let (_ : Core_thread.t) = - Core_thread.create - ~on_uncaught_exn:`Kill_whole_process + let (_ : Thread.t) = + Thread.create (fun () -> - Bopkit_memory.event_loop mem ~read_only:true; - Stdlib.exit 0) + (match Bopkit_memory.event_loop mem ~read_only:true with + | () -> 0 + | exception e -> + prerr_endline (Exn.to_string e); + 1) + |> Stdlib.exit) () in Bopkit_memory.draw mem); diff --git a/project/visa/lib/visa_simulator/src/dune b/project/visa/lib/visa_simulator/src/dune index 43ca6c32..4ba825d9 100644 --- a/project/visa/lib/visa_simulator/src/dune +++ b/project/visa/lib/visa_simulator/src/dune @@ -20,9 +20,6 @@ bit_utils cmdlang core - core_unix - core_unix.core_thread - core_unix.sys_unix fpath fpath-base loc @@ -31,6 +28,8 @@ pp-log.cli pp-log.err stdio + threads + unix visa visa_assembler visa_syntax) diff --git a/project/visa/lib/visa_simulator/src/visa_simulator.ml b/project/visa/lib/visa_simulator/src/visa_simulator.ml index b57229c8..63869798 100644 --- a/project/visa/lib/visa_simulator/src/visa_simulator.ml +++ b/project/visa/lib/visa_simulator/src/visa_simulator.ml @@ -221,7 +221,7 @@ let run (t : t) = let count_output = ref 0 in With_return.with_return (fun return -> (* Make it possible to interrupt the simulation on SIGINT. *) - Sys_unix.catch_break true; + Stdlib.Sys.catch_break true; (try while true do match step t with @@ -232,11 +232,9 @@ let run (t : t) = | Sleep -> if t.config.sleep then ( - let current_time = Core_unix.gettimeofday () in - let start_of_current_sec = - current_time |> Core_unix.gmtime |> Core_unix.timegm - in - Core_thread.delay (1. -. (current_time -. start_of_current_sec))) + let current_time = Unix.gettimeofday () in + let start_of_current_sec = Int.of_float current_time |> Float.of_int in + Thread.delay (1. -. (current_time -. start_of_current_sec))) | Write _ -> let output = Output_device.to_string output_device in if String.( <> ) output !last_output @@ -254,7 +252,7 @@ let run (t : t) = then return.return (Ok ()) done with - | Sys_unix.Break -> ()); + | Stdlib.Sys.Break -> ()); Ok ()) ;; diff --git a/stdlib/7-segment/src/cmd_digital_calendar_gen_input.ml b/stdlib/7-segment/src/cmd_digital_calendar_gen_input.ml index 2dac3542..0bfe92de 100644 --- a/stdlib/7-segment/src/cmd_digital_calendar_gen_input.ml +++ b/stdlib/7-segment/src/cmd_digital_calendar_gen_input.ml @@ -10,11 +10,11 @@ let day_of_week = function | _ -> failwith "day_of_week" ;; -let now () = Caml_unix.localtime (Caml_unix.time ()) +let now () = Unix.localtime (Unix.time ()) type t = bool array -let blit_time (t : t) (tm : Caml_unix.tm) = +let blit_time (t : t) (tm : Unix.tm) = assert (Array.length t = 91); let () = let day_of_week = @@ -49,7 +49,7 @@ let main = (let%map_open.Command () = Arg.return () in let t = Array.create ~len:91 false in while true do - Core_thread.delay 0.2; + Thread.delay 0.2; blit_time t (now ()); print t done) diff --git a/stdlib/7-segment/src/cmd_digital_calendar_gen_raw_input.ml b/stdlib/7-segment/src/cmd_digital_calendar_gen_raw_input.ml index f3e6ba92..5e15dcc8 100644 --- a/stdlib/7-segment/src/cmd_digital_calendar_gen_raw_input.ml +++ b/stdlib/7-segment/src/cmd_digital_calendar_gen_raw_input.ml @@ -9,11 +9,11 @@ let set_binary_value_in_array ~dst ~dst_pos ~value ~len = done ;; -let now () = Core_unix.localtime (Core_unix.time ()) +let now () = Unix.localtime (Unix.time ()) type t = int array -let blit_time (t : t) (tm : Core_unix.tm) = +let blit_time (t : t) (tm : Unix.tm) = (* assert tab is a expected_octets * 8 -length int array *) let set value dst_pos = set_binary_value_in_array ~dst:t ~dst_pos ~value ~len:8 in set tm.tm_sec 0; @@ -36,7 +36,7 @@ let main = (let%map_open.Command () = Arg.return () in let t = Array.create ~len:(expected_octets * 8) 0 in while true do - Core_thread.delay 0.2; + Thread.delay 0.2; blit_time t (now ()); print t done) diff --git a/stdlib/7-segment/src/cmd_digital_calendar_map_raw_input.ml b/stdlib/7-segment/src/cmd_digital_calendar_map_raw_input.ml index 0e33a55a..fbed31ab 100644 --- a/stdlib/7-segment/src/cmd_digital_calendar_map_raw_input.ml +++ b/stdlib/7-segment/src/cmd_digital_calendar_map_raw_input.ml @@ -27,9 +27,7 @@ let dec7 = function | 7 -> 0, 0, 0, 0, 1, 1, 1 | 8 -> 1, 1, 1, 1, 1, 1, 1 | 9 -> 1, 1, 0, 1, 1, 1, 1 - | value -> - let open Core in - raise_s [%sexp "dec7", [%here], { value : int }] + | value -> raise_s [%sexp "dec7", [%here], { value : int }] ;; (* code de 1 à 7 *) diff --git a/stdlib/7-segment/src/cmd_digital_watch_gen_input.ml b/stdlib/7-segment/src/cmd_digital_watch_gen_input.ml index 97a7d443..c32373df 100644 --- a/stdlib/7-segment/src/cmd_digital_watch_gen_input.ml +++ b/stdlib/7-segment/src/cmd_digital_watch_gen_input.ml @@ -5,11 +5,8 @@ module Time_of_day = struct ; sec : int } - let of_unix_time (t : Caml_unix.tm) = - { hour = t.tm_hour; min = t.tm_min; sec = t.tm_sec } - ;; - - let now () = Caml_unix.localtime (Caml_unix.time ()) |> of_unix_time + let of_unix_time (t : Unix.tm) = { hour = t.tm_hour; min = t.tm_min; sec = t.tm_sec } + let now () = Unix.localtime (Unix.time ()) |> of_unix_time end type t = bool array @@ -45,7 +42,7 @@ let main = done else while true do - ignore (Caml_threads.Thread.delay 0.5 : unit); + ignore (Thread.delay 0.5 : unit); blit_time t (Time_of_day.now ()); print t done) diff --git a/stdlib/7-segment/src/dune b/stdlib/7-segment/src/dune index 29461d94..a72b4cf3 100644 --- a/stdlib/7-segment/src/dune +++ b/stdlib/7-segment/src/dune @@ -13,19 +13,7 @@ Stdio -open Cmdlang) - (libraries - ANSITerminal - base - bit_utils - cmdlang - core - core_kernel.caml_threads - core_kernel.caml_unix - core_unix - core_unix.core_thread - graphics - stdio - threads) + (libraries ANSITerminal base bit_utils cmdlang graphics stdio threads unix) (lint (pps ppx_js_style -check-doc-comments)) (preprocess diff --git a/stdlib/7-segment/src/seven_segment_display.ml b/stdlib/7-segment/src/seven_segment_display.ml index 3e912357..5a34f046 100644 --- a/stdlib/7-segment/src/seven_segment_display.ml +++ b/stdlib/7-segment/src/seven_segment_display.ml @@ -62,7 +62,7 @@ let make_print_command (module Device : DEVICE_S) ~length ~name = Arg.flag [ "clear-on-reprint" ] ~doc:"on tty print only 1 line" and print_index = Arg.flag [ "print-index" ] ~doc:"print cycle index as prefix" and print_on_change = Arg.flag [ "print-on-change" ] ~doc:"print only on change" in - if clear_on_reprint && not (ANSITerminal.isatty.contents Core_unix.stdout) + if clear_on_reprint && not (ANSITerminal.isatty.contents Unix.stdout) then ( Stdlib.Printf.eprintf "clear-on-reprint can only be used if the terminal is a tty\n%!"; diff --git a/stdlib/bopboard/src/bopboard.ml b/stdlib/bopboard/src/bopboard.ml index afa7e2ec..6bc0f511 100644 --- a/stdlib/bopboard/src/bopboard.ml +++ b/stdlib/bopboard/src/bopboard.ml @@ -72,7 +72,7 @@ let find_image ~image = let ( ^/ ) = Stdlib.Filename.concat in List.find_map Bopkit_sites.Sites.bopboard ~f:(fun bopboard_directory -> let file = bopboard_directory ^/ "images" ^/ Image.basename image in - if Sys_unix.file_exists_exn file then Some file else None) + if Stdlib.Sys.file_exists file then Some file else None) ;; let result_exn = function @@ -388,8 +388,15 @@ let run_cmd = ~doc:"set window title" in let t = init ~title in - let (_ : Core_thread.t) = - Core_thread.create ~on_uncaught_exn:`Kill_whole_process event_loop t + let (_ : Thread.t) = + Thread.create + (fun () -> + match event_loop t with + | () -> () + | exception e -> + prerr_endline (Exn.to_string e); + Stdlib.exit 1) + () in Bopkit_block.create ~name:"bopboard" diff --git a/stdlib/bopboard/src/dune b/stdlib/bopboard/src/dune index 88e158c9..c59c9a88 100644 --- a/stdlib/bopboard/src/dune +++ b/stdlib/bopboard/src/dune @@ -19,8 +19,6 @@ bopkit_sites cmdlang core - core_unix.core_thread - core_unix.sys_unix graphics stdio threads diff --git a/stdlib/memories/bin/dune b/stdlib/memories/bin/dune index 8d26991a..cf8faa9c 100644 --- a/stdlib/memories/bin/dune +++ b/stdlib/memories/bin/dune @@ -16,7 +16,6 @@ bit_utils cmdlang core - core_unix.core_thread bopkit_block bopkit_memory bopkit_sleeper diff --git a/stdlib/memories/bin/ram_memory.ml b/stdlib/memories/bin/ram_memory.ml index aed85c49..09ee5610 100644 --- a/stdlib/memories/bin/ram_memory.ml +++ b/stdlib/memories/bin/ram_memory.ml @@ -9,12 +9,15 @@ let init ~title ~address_width ~data_width = let title = Option.value title ~default:"RAM MEMORY" in Graphics.set_window_title title; let mem = Bopkit_memory.create ~name:"ram" ~address_width ~data_width ~kind:Ram () in - let (_ : Core_thread.t) = - Core_thread.create - ~on_uncaught_exn:`Kill_whole_process + let (_ : Thread.t) = + Thread.create (fun () -> - Bopkit_memory.event_loop mem ~read_only:false; - Stdlib.exit 0) + (match Bopkit_memory.event_loop mem ~read_only:false with + | () -> 0 + | exception e -> + prerr_endline (Exn.to_string e); + 1) + |> Stdlib.exit) () in Bopkit_memory.draw mem; diff --git a/subleq.opam b/subleq.opam index b9de68d8..395cf2bb 100644 --- a/subleq.opam +++ b/subleq.opam @@ -21,7 +21,6 @@ depends: [ "cmdlang-to-cmdliner" {>= "0.0.9"} "cmdliner" {>= "1.3.0"} "core" {>= "v0.17" & < "v0.18"} - "core_unix" {>= "v0.17" & < "v0.18"} "dune-site" {>= "3.17"} "fpath" {>= "0.7.3"} "fpath-base" {>= "0.2.2"} diff --git a/visa.opam b/visa.opam index 2ed1d5fb..bd8cf6e2 100644 --- a/visa.opam +++ b/visa.opam @@ -21,7 +21,6 @@ depends: [ "cmdlang-to-cmdliner" {>= "0.0.9"} "cmdliner" {>= "1.3.0"} "core" {>= "v0.17" & < "v0.18"} - "core_unix" {>= "v0.17" & < "v0.18"} "dune-site" {>= "3.17"} "fpath" {>= "0.7.3"} "fpath-base" {>= "0.2.2"}