Jbuilder: use --dev option

Makefile

@@ -1,15 +1,15 @@
 
 all:
-	@jbuilder build tezos.install
+	@jbuilder build tezos.install --dev
 	@cp _build/default/src/node_main.exe tezos-node
 	@cp _build/default/src/client_main.exe tezos-client
 	@cp _build/default/src/compiler_main.exe tezos-protocol-compiler
 
 doc-html:
-	@jbuilder build @doc
+	@jbuilder build @doc --dev
 
 build-test:
-	@jbuilder build @buildtest
+	@jbuilder build @buildtest --dev
 
 test:
 	@jbuilder runtest

src/client/client_generic_rpcs.ml

@@ -16,7 +16,6 @@ open Json_schema
 
 (*-- Assisted, schema directed input fill in --------------------------------*)
 
-exception Erroneous_construct
 exception Unsupported_construct
 
 type input = {
@@ -132,7 +131,7 @@ let editor_fill_in schema =
     random_fill_in schema >>= function
     | Error msg -> Lwt.return (Error msg)
     | Ok json ->
-        Lwt_io.(with_file Output tmp (fun fp ->
+        Lwt_io.(with_file ~mode:Output tmp (fun fp ->
             write_line fp (Data_encoding_ezjsonm.to_string json))) >>= fun () ->
         edit ()
   and edit () =
@@ -160,7 +159,7 @@ let editor_fill_in schema =
         Lwt.return (Error msg)
   and reread () =
     (* finally reread the file *)
-    Lwt_io.(with_file Input tmp (fun fp -> read fp)) >>= fun text ->
+    Lwt_io.(with_file ~mode:Input tmp (fun fp -> read fp)) >>= fun text ->
     match Data_encoding_ezjsonm.from_string text with
     | Ok r -> Lwt.return (Ok r)
     | Error msg -> Lwt.return (Error (Printf.sprintf "bad input: %s" msg))
@@ -350,7 +349,6 @@ let call_with_json url json (cctxt: Client_commands.context) =
         "Failed to parse the provided json: %s\n%!"
         err
   | Ok json ->
-      let open RPC.Description in
       Client_rpcs.get_json cctxt.rpc_config `POST args json >>=? fun json ->
       cctxt.message "%a"
         Json_repr.(pp (module Ezjsonm)) json >>= fun () ->

src/client/client_helpers.ml

@@ -8,7 +8,6 @@
 (**************************************************************************)
 
 open Client_commands
-open Client_config
 
 let unique_switch =
   Cli_entries.switch

src/client/client_keys.ml

@@ -162,7 +162,7 @@ let alias_keys cctxt name =
   let rec find_key = function
     | [] -> return None
     | (key_name, pkh) :: tl ->
-        if String.(key_name = name)
+        if key_name = name
         then
           Public_key.find_opt cctxt name >>=? fun pkm ->
           Secret_key.find_opt cctxt name >>=? fun pks ->

src/client/embedded/alpha/client_baking_daemon.ml

@@ -8,7 +8,6 @@
 (**************************************************************************)
 
 open Client_commands
-open Logging.Client.Baking
 
 let run cctxt ?max_priority ~delay ?min_date delegates ~endorsement ~denunciation ~baking =
   (* TODO really detach... *)

src/client/embedded/alpha/client_baking_endorsement.ml

@@ -9,7 +9,6 @@
 
 open Logging.Client.Endorsement
 open Client_commands
-open Cli_entries
 
 module Ed25519 = Environment.Ed25519
 

src/client/embedded/alpha/client_baking_forge.ml

@@ -20,7 +20,7 @@ let generate_seed_nonce () =
   | Error _ -> assert false
   | Ok nonce -> nonce
 
-let rec forge_block_header
+let forge_block_header
     cctxt block delegate_sk shell priority seed_nonce_hash =
   Client_proto_rpcs.Constants.stamp_threshold
     cctxt block >>=? fun stamp_threshold ->
@@ -620,6 +620,3 @@ let create
   lwt_log_info "Starting baking daemon" >>= fun () ->
   worker_loop () >>= fun () ->
   return ()
-
-(* FIXME bug in ocamldep ?? *)
-open Level

src/client/embedded/alpha/client_baking_main.ml

@@ -7,9 +7,7 @@
 (*                                                                        *)
 (**************************************************************************)
 
-open Cli_entries
 open Client_commands
-open Client_proto_contracts
 
 let mine_block cctxt block
     ?force ?max_priority ?(free_baking=false) ?src_sk delegate =

src/client/embedded/alpha/client_baking_operations.ml

@@ -9,8 +9,6 @@
 
 module Ed25519 = Environment.Ed25519
 
-open Operation
-
 type operation = {
   hash: Operation_hash.t ;
   content: Operation.t option

src/client/embedded/alpha/client_baking_revelation.ml

@@ -7,7 +7,6 @@
 (*                                                                        *)
 (**************************************************************************)
 
-open Cli_entries
 open Tezos_context
 
 let inject_seed_nonce_revelation rpc_config block ?force ?async nonces =
@@ -22,8 +21,6 @@ let inject_seed_nonce_revelation rpc_config block ?force ?async nonces =
   Client_node_rpcs.inject_operation rpc_config ?force ?async bytes >>=? fun oph ->
   return oph
 
-type Error_monad.error += Bad_revelation
-
 let forge_seed_nonce_revelation
     (cctxt: Client_commands.context)
     block ?(force = false) nonces =

src/client/embedded/alpha/client_proto_args.ml

@@ -115,8 +115,8 @@ let tez_arg ~default ~parameter ~doc =
 
 let tez_param ~name ~desc next =
   Cli_entries.param
-    name
+    ~name
-    (desc ^ " in \xEA\x9C\xA9\n" ^ tez_format)
+    ~desc:(desc ^ " in \xEA\x9C\xA9\n" ^ tez_format)
     (tez_parameter name)
     next
 

src/client/embedded/alpha/client_proto_contracts.ml

@@ -134,7 +134,6 @@ let get_manager cctxt block source =
   | None -> Client_proto_rpcs.Context.Contract.manager cctxt block source
 
 let get_delegate cctxt block source =
-  let open Client_keys in
   match Contract.is_default source with
   | Some hash -> return hash
   | None ->

src/client/embedded/alpha/client_proto_nonces.ml

@@ -7,8 +7,6 @@
 (*                                                                        *)
 (**************************************************************************)
 
-open Cli_entries
-
 (* TODO locking... *)
 
 type t = (Block_hash.t * Nonce.t) list

src/client/embedded/alpha/client_proto_programs.ml

@@ -101,7 +101,6 @@ let commands () =
          data_parameter
        @@ stop)
       (fun (trace_stack, amount, no_print_source) program storage input cctxt ->
-         let open Data_encoding in
          let print_errors errs =
            cctxt.warning "%a"
              (Michelson_v1_error_reporter.report_errors
@@ -147,7 +146,6 @@ let commands () =
        @@ Program.source_param
        @@ stop)
       (fun (show_types, emacs_mode, no_print_source) program cctxt ->
-         let open Data_encoding in
          Client_proto_rpcs.Helpers.typecheck_code
            cctxt.rpc_config cctxt.config.block program.expanded >>= fun res ->
          if emacs_mode then
@@ -191,7 +189,6 @@ let commands () =
          data_parameter
        @@ stop)
       (fun no_print_source data exp_ty cctxt ->
-         let open Data_encoding in
          Client_proto_rpcs.Helpers.typecheck_data cctxt.Client_commands.rpc_config
            cctxt.config.block (data.expanded, exp_ty.expanded) >>= function
          | Ok () ->
@@ -214,7 +211,6 @@ let commands () =
          data_parameter
        @@ stop)
       (fun () data cctxt ->
-         let open Data_encoding in
          Client_proto_rpcs.Helpers.hash_data cctxt.Client_commands.rpc_config
            cctxt.config.block (data.expanded) >>= function
          | Ok hash ->
@@ -237,7 +233,6 @@ let commands () =
        @@ Client_keys.Secret_key.alias_param
        @@ stop)
       (fun () data (_, key) cctxt ->
-         let open Data_encoding in
          Client_proto_rpcs.Helpers.hash_data cctxt.rpc_config
            cctxt.config.block (data.expanded) >>= function
          | Ok hash ->

src/client/embedded/alpha/client_proto_rpcs.ml

@@ -185,8 +185,6 @@ module Helpers = struct
 
   module Forge = struct
 
-    open Operation
-
     module Manager = struct
       let operations cctxt
           block ~net_id ~branch ~source ?sourcePubKey ~counter ~fee operations =

src/client/embedded/alpha/jbuild

@@ -2,11 +2,13 @@
 
 (library
  ((name client_embedded_alpha)
+  (public_name tezos.client.embedded.alpha)
   (libraries (tezos_embedded_protocol_alpha
               tezos_embedded_raw_protocol_alpha
               client_lib))
   (library_flags (:standard -linkall))
-  (flags (:standard -w +27-30-40@8
+  (flags (:standard -w -9+27-30-32-40@8
+                    -safe-string
                     -open Error_monad
                     -open Hash
                     -open Utils

src/client/embedded/alpha/michelson_macros.mli

@@ -7,8 +7,6 @@
 (*                                                                        *)
 (**************************************************************************)
 
-open Micheline
-
 type 'l node = ('l, string) Micheline.node
 
 val expand : 'l node -> 'l node

src/client/embedded/alpha/michelson_v1_error_reporter.ml

@@ -17,7 +17,7 @@ let print_ty (type t) ppf (annot, (ty : t ty)) =
   |> Micheline.strip_locations
   |> Michelson_v1_printer.print_expr_unwrapped ppf
 
-let rec print_stack_ty (type t) ?(depth = max_int) ppf (s : t stack_ty) =
+let print_stack_ty (type t) ?(depth = max_int) ppf (s : t stack_ty) =
   let rec loop
     : type t. int -> Format.formatter -> t stack_ty -> unit
     = fun depth ppf -> function

src/client/embedded/alpha/michelson_v1_parser.ml

@@ -59,7 +59,7 @@ let parse_toplevel ?check source =
     | [ ast ] -> ast
     | asts ->
         let start = min_point asts and stop = max_point asts in
-        Seq (Michelson_macros.{ start ; stop }, asts, None) in
+        Seq ({ start ; stop }, asts, None) in
   expand_all source ast
 
 let parse_expression ?check source =

src/client/embedded/alpha/michelson_v1_parser.mli

@@ -9,23 +9,21 @@
 
 (** The result of parsing and expanding a Michelson V1 script or data. *)
 type parsed =
-  { source :
+  {
+    source : string ;
     (** The original source code. *)
-      string ;
+    unexpanded : string Micheline.canonical ;
-    unexpanded :
     (** Original expression with macros. *)
-      string Micheline.canonical ;
+    expanded : Script.expr ;
-    expanded :
     (** Expression with macros fully expanded. *)
-      Script.expr ;
     expansion_table :
+      (int * (Micheline_parser.location * int list)) list ;
     (** Associates unexpanded nodes to their parsing locations and
         the nodes expanded from it in the expanded expression. *)
-      (int * (Micheline_parser.location * int list)) list ;
+    unexpansion_table : (int * int) list ;
-    unexpansion_table :
     (** Associates an expanded node to its source in the unexpanded
         expression. *)
-      (int * int) list }
+  }
 
 val parse_toplevel : ?check:bool -> string -> parsed tzresult
 val parse_expression : ?check:bool -> string -> parsed tzresult

src/client/embedded/genesis/jbuild

@@ -2,12 +2,14 @@
 
 (library
  ((name client_embedded_genesis)
+  (public_name tezos.client.embedded.genesis)
   (libraries (tezos_embedded_raw_protocol_genesis
               tezos_embedded_protocol_genesis
               tezos_protocol_environment_alpha
               client_lib))
   (library_flags (:standard -linkall))
-  (flags (:standard -w +27-30-40@8
+  (flags (:standard -w -9+27-30-32-40@8
+                    -safe-string
                     -open Error_monad
                     -open Hash
                     -open Utils

src/client/jbuild

@@ -10,7 +10,8 @@
               node_db
               node_updater
               tezos_protocol_compiler))
-  (flags (:standard -w +27-30-40@8
+  (flags (:standard -w -9+27-30-32-40@8
+                    -safe-string
                     -open Error_monad
                     -open Hash
                     -open Utils

src/client_main.ml

@@ -9,7 +9,6 @@
 
 (* Tezos Command line interface - Main Program *)
 
-open Lwt.Infix
 open Client_commands
 open Error_monad
 

src/compiler/jbuild

@@ -21,7 +21,8 @@
               ocplib-endian
               ocplib-ocamlres
               unix))
-  (flags (:standard -w +27-30-40@8
+  (flags (:standard -w -9+27-30-32-40@8
+                    -safe-string
                     -opaque
                     -open Error_monad
                     -open Hash

src/compiler/native.ml

@@ -53,7 +53,6 @@ let preloaded_cmis : (string, Env.Persistent_signature.t) Hashtbl.t =
 
 (* Set hook *)
 let () =
-  let open Env.Persistent_signature in
   Env.Persistent_signature.load :=
     (fun ~unit_name ->
        try Some (Hashtbl.find preloaded_cmis (String.capitalize_ascii unit_name))
@@ -154,12 +153,12 @@ let hash_file file =
   let buf = BytesLabels.create buflen in
   let fd = Unix.openfile file [Unix.O_RDONLY] 0o600 in
   let state = init ~size:32 () in
-  let rec loop () =
+  let loop () =
     match Unix.read fd buf 0 buflen with
     | 0 -> ()
     | nb_read ->
         Bytes.update state @@
-        if nb_read = buflen then buf else BytesLabels.sub buf 0 nb_read
+        if nb_read = buflen then buf else BytesLabels.sub buf ~pos:0 ~len:nb_read
   in
   loop () ;
   Unix.close fd ;

src/environment/jbuild

@@ -52,5 +52,5 @@
 (library
  ((name tezos_protocol_environment_sigs)
   (public_name tezos.protocol_environment.sigs)
-  (flags (:standard -nopervasives))
+  (flags (:standard -safe-string -w -9-32 -nopervasives))
   (modules ("V1"))))

src/environment/sigs_packer/jbuild

@@ -2,5 +2,6 @@
 
 (executable
   ((name sigs_packer)
-  (public_name tezos-protocol-environment-sigs-packer)))
+   (public_name tezos-protocol-environment-sigs-packer)
+   (flags (:standard -w -9-32 -safe-string))))
 

src/environment/sigs_packer/sigs_packer.ml

@@ -14,7 +14,7 @@ let dump_file oc file =
   let rec loop () =
     let len = input ic buf 0 buflen in
     if len <> 0 then begin
-      Printf.fprintf oc "%s" (if len = buflen then buf else Bytes.sub buf 0 len) ;
+      Printf.fprintf oc "%s" (Bytes.to_string (if len = buflen then buf else Bytes.sub buf 0 len)) ;
       loop ()
     end
   in
@@ -32,15 +32,15 @@ let include_mli oc file =
   let unit =
     String.capitalize_ascii
       (Filename.chop_extension (Filename.basename file)) in
-  Printf.fprintf stdout "module %s : sig\n" unit ;
+  Printf.fprintf oc "module %s : sig\n" unit ;
-  Printf.fprintf stdout "# 1 %S\n" file ;
+  Printf.fprintf oc "# 1 %S\n" file ;
-  dump_file stdout file ;
+  dump_file oc file ;
-  Printf.fprintf stdout "end\n" ;
+  Printf.fprintf oc "end\n" ;
   if unit = "Result" then
-    Printf.fprintf stdout
+    Printf.fprintf oc
       "type ('a, 'b) result = ('a, 'b) Result.result = \
       \ Ok of 'a | Error of 'b\n" ;
-  if List.mem unit opened_modules then Printf.fprintf stdout "open %s\n" unit
+  if List.mem unit opened_modules then Printf.fprintf oc "open %s\n" unit
 
 let () =
   Printf.fprintf stdout "module type T = sig\n" ;

src/environment/v1/tezos_data.mli

@@ -95,11 +95,11 @@ module Protocol : sig
 
   (** An OCaml source component of a protocol implementation. *)
   and component = {
-    (** The OCaml module name. *)
+    (* The OCaml module name. *)
     name : string ;
-    (** The OCaml interface source code *)
+    (* The OCaml interface source code *)
     interface : string option ;
-    (** The OCaml source code *)
+    (* The OCaml source code *)
     implementation : string ;
   }
 

src/environment/v1/z.mli

@@ -64,11 +64,13 @@ val of_string: string -> t
 
 external to_int64: t -> int64 = "ml_z_to_int64"
 (** Converts to a 64-bit integer. May raise [Overflow]. *)
+
 external of_int64: int64 -> t = "ml_z_of_int64"
 (** Converts from a 64-bit integer. *)
 
 external to_int: t -> int = "ml_z_to_int"
 (** Converts to a base integer. May raise an [Overflow]. *)
+
 external of_int: int -> t = "ml_z_of_int" [@@ noalloc]
 (** Converts from a base integer. *)
 

src/jbuild

@@ -4,7 +4,8 @@
  ((name compiler_main)
   (public_name tezos-protocol-compiler)
   (libraries (tezos_protocol_compiler))
-  (flags (:standard -w +27-30-40@8
+  (flags (:standard -w -9+27-30-32-40@8
+                    -safe-string
                     -linkall))
   (modules (Compiler_main))))
 
@@ -15,7 +16,8 @@
               tezos_embedded_protocol_genesis
               tezos_embedded_protocol_demo
               tezos_embedded_protocol_alpha))
-  (flags (:standard -w +27-30-40@8
+  (flags (:standard -w -9+27-30-32-40@8
+                    -safe-string
                     -linkall))
   (modules (Node_main))))
 
@@ -23,6 +25,7 @@
  ((name client_main)
   (public_name tezos-client)
   (libraries (lwt utils client_lib client_embedded_genesis client_embedded_alpha))
-  (flags (:standard -w +27-30-40@8
+  (flags (:standard -w -9+27-30-32-40@8
+                    -safe-string
                     -linkall))
   (modules (Client_main))))

src/micheline/jbuild

@@ -11,7 +11,7 @@
     minutils
     utils
     ))
-  (flags (:standard -w +27-30-40@8))
+  (flags (:standard -w -9+27-30-32-40@8 -safe-string))
   (wrapped false)))
 
 

src/micheline/micheline_printer.ml

@@ -7,7 +7,6 @@
 (*                                                                        *)
 (**************************************************************************)
 
-open Error_monad
 open Micheline
 
 type location = { comment : string option }

src/micheline/micheline_printer.mli

@@ -7,7 +7,6 @@
 (*                                                                        *)
 (**************************************************************************)
 
-open Error_monad
 open Micheline
 
 val print_string : Format.formatter -> string -> unit

src/minutils/compare.ml

@@ -159,7 +159,7 @@ end
 
 module Option(P : S) = struct
   type t = P.t option
-  let rec compare xs ys =
+  let compare xs ys =
     match xs, ys with
     | None, None -> 0
     | None, _ -> -1

src/minutils/data_encoding.ml

@@ -7,8 +7,6 @@
 (*                                                                        *)
 (**************************************************************************)
 
-open Utils
-
 type json =
   [ `O of (string * json) list
   | `Bool of bool
@@ -17,10 +15,6 @@ type json =
   | `Null
   | `String of string ]
 
-and document =
-  [ `O of (string * json) list
-  | `A of json list ]
-
 type json_schema = Json_schema.schema
 
 exception No_case_matched
@@ -172,8 +166,7 @@ and 'a t = {
 
 type 'a encoding = 'a t
 
-let rec classify : type a l. a t -> Kind.t = fun e ->
+let rec classify : type a. a t -> Kind.t = fun e ->
-  let open Kind in
   match e.encoding with
   (* Fixed *)
   | Null -> `Fixed 0
@@ -222,8 +215,6 @@ module Json = struct
 
   exception Parse_error of string
 
-  type nonrec json = json
-
   let wrap_error f =
     fun str ->
       try f str
@@ -292,7 +283,7 @@ module Json = struct
     | _ -> e
 
   and lift_union_in_pair
-    : type a a_l b b_l. pair_builder -> Kind.t -> a t -> b t -> (a * b) t
+    : type a b. pair_builder -> Kind.t -> a t -> b t -> (a * b) t
     = fun b p e1 e2 ->
     match lift_union e1, lift_union e2 with
     | e1, { encoding = Union (_kind, tag, cases) } ->
@@ -323,7 +314,7 @@ module Json = struct
                  cases)
     | e1, e2 -> b.build p e1 e2
 
-  let rec json : type a l. a desc -> a Json_encoding.encoding =
+  let rec json : type a. a desc -> a Json_encoding.encoding =
     let open Json_encoding in
     function
     | Null -> null
@@ -362,19 +353,19 @@ module Json = struct
     | Delayed f -> get_json (f ())
 
   and field_json
-    : type a l. a field -> a Json_encoding.field =
+    : type a. a field -> a Json_encoding.field =
     let open Json_encoding in
     function
     | Req (name, e) -> req name (get_json e)
     | Opt (_, name, e) -> opt name (get_json e)
     | Dft (name, e, d) -> dft name (get_json e) d
 
-  and case_json : type a l. a case -> a Json_encoding.case =
+  and case_json : type a. a case -> a Json_encoding.case =
     let open Json_encoding in
     function
     | Case { encoding = e ; proj ; inj ; _ } -> case (get_json e) proj inj
 
-  and get_json : type a l. a t -> a Json_encoding.encoding = fun e ->
+  and get_json : type a. a t -> a Json_encoding.encoding = fun e ->
     match e.json_encoding with
     | None ->
         let json_encoding = json (lift_union e).encoding in
@@ -459,7 +450,7 @@ module Encoding = struct
   let array e = dynamic_size (Variable.array e)
   let list e = dynamic_size (Variable.list e)
 
-  let conv (type l) proj inj ?schema encoding =
+  let conv proj inj ?schema encoding =
     make @@ Conv { proj ; inj ; encoding ; schema }
 
   let string_enum l = dynamic_size (Variable.string_enum l)
@@ -546,7 +537,7 @@ module Encoding = struct
     raw_merge_objs (obj2 f10 f9) (obj8 f8 f7 f6 f5 f4 f3 f2 f1)
 
   let merge_objs o1 o2 =
-    let rec is_obj : type a l. a t -> bool = fun e ->
+    let rec is_obj : type a. a t -> bool = fun e ->
       match e.encoding with
       | Obj _ -> true
       | Objs _ (* by construction *) -> true
@@ -587,7 +578,7 @@ module Encoding = struct
     raw_merge_tups (tup2 e10 e9) (tup8 e8 e7 e6 e5 e4 e3 e2 e1)
 
   let merge_tups t1 t2 =
-    let rec is_tup : type a l. a t -> bool = fun e ->
+    let rec is_tup : type a. a t -> bool = fun e ->
       match e.encoding with
       | Tup _ -> true
       | Tups _ (* by construction *) -> true
@@ -745,7 +736,6 @@ module Binary = struct
   }
 
 let rec length : type x. x t -> x -> int = fun e ->
-    let open Kind in
     match e.encoding with
     (* Fixed *)
     | Null -> fun _ -> 0
@@ -780,7 +770,7 @@ let rec length : type x. x t -> x -> int = fun e ->
           | Case { tag = None } -> None
           | Case { encoding = e ; proj ; tag = Some _ } ->
               let length v = tag_size sz + length e v in
-              Some (fun v -> Utils.map_option length (proj v)) in
+              Some (fun v -> Utils.map_option ~f:length (proj v)) in
         apply (Utils.filter_map case_length cases)
     | Mu (`Dynamic, _name, self) ->
         fun v -> length (self e) v
@@ -953,8 +943,7 @@ let rec length : type x. x t -> x -> int = fun e ->
   end
 
   let rec write_rec
-    : type a l. a t -> a -> MBytes.t -> int -> int = fun e ->
+    : type a. a t -> a -> MBytes.t -> int -> int = fun e ->
-    let open Kind in
     let open Writer in
     match e.encoding with
     | Null -> (fun () _buf ofs -> ofs)
@@ -1159,8 +1148,7 @@ let rec length : type x. x t -> x -> int = fun e ->
 
   end
 
-  let rec read_rec : type a l. a t-> MBytes.t -> int -> int -> int * a = fun e ->
+  let rec read_rec : type a. a t-> MBytes.t -> int -> int -> int * a = fun e ->
-    let open Kind in
     let open Reader in
     match e.encoding with
     | Null -> (fun _buf ofs _len -> ofs, ())

src/minutils/jbuild

@@ -7,5 +7,5 @@
                  lwt
                  ocplib-json-typed.bson
                  ocplib-resto.directory))
-     (flags (:standard -w +27-30-40@8))
+     (flags (:standard -w -9+27-30-32-40@8 -safe-string))
      (wrapped false)))

src/minutils/utils.ml

@@ -147,7 +147,7 @@ let rec remove_elem_from_list nb = function
   | l when nb <= 0 -> l
   | _ :: tl -> remove_elem_from_list (nb - 1) tl
 
-let rec split_list_at n l =
+let split_list_at n l =
   let rec split n acc = function
   | [] -> List.rev acc, []
   | l when n <= 0 -> List.rev acc, l
@@ -196,7 +196,7 @@ let write_file ?(bin=false) fn contents =
 
 let (<<) g f = fun a -> g (f a)
 
-let rec (--) i j =
+let (--) i j =
   let rec loop acc j =
     if j < i then acc else loop (j :: acc) (pred j) in
   loop [] j

src/minutils/utils.mli

@@ -62,6 +62,7 @@ val filter_map: ('a -> 'b option) -> 'a list -> 'b list
 
 (** [list_rev_sub l n] is [List.rev l] capped to max [n] elements *)
 val list_rev_sub : 'a list -> int -> 'a list
+
 (** [list_sub l n] is [l] capped to max [n] elements *)
 val list_sub: 'a list -> int -> 'a list
 

src/node/db/context.ml

@@ -10,7 +10,6 @@
 (** Tezos - Versioned (key x value) store (over Irmin) *)
 
 open Hash
-open Logging.Db
 
 module IrminPath = Irmin.Path.String_list
 
@@ -95,9 +94,6 @@ let checkout_exn index key =
   | Some p -> Lwt.return p
 
 
-exception Preexistent_context of Block_hash.t
-exception Empty_head of Block_hash.t
-
 let raw_commit ~time ~message context =
   let info =
     Irmin.Info.v ~date:(Time.to_seconds time) ~author:"Tezos" message in
@@ -116,6 +112,7 @@ let commit ~time ~message context =
     Lwt_utils.Idle_waiter.force_idle
       context.index.repack_scheduler
       begin fun () ->
+        let open Logging.Db in
         lwt_debug "begin git repack" >>= fun () ->
         let command =
           "git",
@@ -138,8 +135,6 @@ let commit ~time ~message context =
 
 (*-- Generic Store Primitives ------------------------------------------------*)
 
-type key = string list
-
 let data_key key = "data" :: key
 let undata_key = function
   | "data" :: key -> key

src/node/db/jbuild

@@ -4,7 +4,8 @@
  ((name node_db)
   (public_name tezos.node.db)
   (libraries (utils minutils leveldb irmin irmin-unix))
-  (flags (:standard -w +27-30-40@8
+  (flags (:standard -w -9+27-30-32-40@8
+                    -safe-string
                     -open Error_monad
                     -open Hash
                     -open Utils

src/node/db/persist.ml

@@ -121,7 +121,6 @@ module MakeBytesStore
 
   type t = S.t
   type key = K.t
-  type value = MBytes.t
 
   let to_path k =
     let suffix = K.to_path k in
@@ -228,8 +227,8 @@ module MakePersistentSet
     | true -> dig K.length K.prefix x
     | false -> Lwt.return x
 
-  let iter c ~f = fold c () (fun x () -> f x)
+  let iter c ~f = fold c () ~f:(fun x () -> f x)
-  let elements c = fold c [] (fun p xs -> Lwt.return (p :: xs))
+  let elements c = fold c [] ~f:(fun p xs -> Lwt.return (p :: xs))
 
 end
 
@@ -239,7 +238,7 @@ module MakeBufferedPersistentSet
   include MakePersistentSet(S)(K)
 
   let read c =
-    fold c Set.empty (fun p set -> Lwt.return (Set.add p set))
+    fold c Set.empty ~f:(fun p set -> Lwt.return (Set.add p set))
 
   let write c set =
     S.set c inited_key empty >>= fun c ->
@@ -307,8 +306,8 @@ module MakePersistentMap
     | true -> dig K.length K.prefix x
     | false -> Lwt.return x
 
-  let iter c ~f = fold c () (fun k v () -> f k v)
+  let iter c ~f = fold c () ~f:(fun k v () -> f k v)
-  let bindings c = fold c [] (fun k v acc -> Lwt.return ((k, v) :: acc))
+  let bindings c = fold c [] ~f:(fun k v acc -> Lwt.return ((k, v) :: acc))
 
 end
 
@@ -317,7 +316,7 @@ module MakeBufferedPersistentMap
 
   include MakePersistentMap(S)(K)(C)
 
-  let read c = fold c Map.empty (fun k v m -> Lwt.return (Map.add k v m))
+  let read c = fold c Map.empty ~f:(fun k v m -> Lwt.return (Map.add k v m))
 
   let write c m =
     clear c >>= fun c ->
@@ -399,10 +398,7 @@ module MakeImperativeProxy
     { rdata: rdata ;
       state: [ `Inited of Scheduler.data | `Initing of Scheduler.data Lwt.t ] ;
       wakener: Store.value Lwt.u }
-  type store = Store.t
   type state = Scheduler.state
-  type key = Store.key
-  type value = Store.value
 
   type t =
     { tbl : data Table.t ;
@@ -594,7 +590,7 @@ module MakeHashResolver
       | [d] ->
           Store.list t [prefix] >>= fun prefixes ->
           Lwt_list.filter_map_p (fun prefix ->
-              match remove_prefix d (List.hd (List.rev prefix)) with
+              match remove_prefix ~prefix:d (List.hd (List.rev prefix)) with
               | None -> Lwt.return_none
               | Some _ -> Lwt.return (Some (build prefix))
             ) prefixes

src/node/db/persist.mli

@@ -9,9 +9,6 @@
 
 (**  Tezos - Persistent structures on top of {!Context} *)
 
-open Lwt
-
-
 (** Keys in (kex x value) database implementations *)
 type key = string list
 

src/node/db/raw_store.ml

@@ -8,7 +8,6 @@
 (**************************************************************************)
 
 module List = ListLabels
-open Logging.Db
 
 type t = LevelDB.db
 type key = string list

src/node/db/store.ml

@@ -7,8 +7,6 @@
 (*                                                                        *)
 (**************************************************************************)
 
-open Store_sigs
-
 type t = Raw_store.t
 type global_store = t
 

src/node/db/store_helpers.ml

@@ -140,7 +140,7 @@ module Make_indexed_substore (S : STORE) (I : INDEX) = struct
           list t prefix >>= fun prefixes ->
           Lwt_list.map_p (function
               | `Key prefix | `Dir prefix ->
-                  match Utils.remove_prefix d (List.hd (List.rev prefix)) with
+                  match Utils.remove_prefix ~prefix:d (List.hd (List.rev prefix)) with
                   | None -> Lwt.return_nil
                   | Some _ -> loop (i+1) prefix [])
             prefixes

src/node/main/jbuild

@@ -2,8 +2,10 @@
 
 (library
  ((name node_main_lib)
+  (public_name tezos.node.main)
   (libraries (utils minutils cmdliner node_net node_shell))
-  (flags (:standard -w +27-30-40@8
+  (flags (:standard -w -9+27-30-32-40@8
+                    -safe-string
                     -open Error_monad
                     -open Hash
                     -open Utils

src/node/main/node_config_file.ml

@@ -7,8 +7,6 @@
 (*                                                                        *)
 (**************************************************************************)
 
-open P2p_types
-
 let (//) = Filename.concat
 
 let home =
@@ -318,7 +316,7 @@ let update
       Utils.first_some
         peer_table_size cfg.net.limits.max_known_peer_ids ;
     binary_chunks_size =
-      Utils.map_option (fun x -> x lsl 10) binary_chunks_size ;
+      Utils.map_option ~f:(fun x -> x lsl 10) binary_chunks_size ;
   } in
   let net : net = {
     expected_pow =

src/node/main/node_config_file.mli

@@ -7,8 +7,6 @@
 (*                                                                        *)
 (**************************************************************************)
 
-open P2p_types
-
 type t = {
   data_dir : string ;
   net : net ;

src/node/main/node_run_command.ml

@@ -47,7 +47,6 @@ let protocol_dir data_dir = data_dir // "protocol"
 let lock_file data_dir = data_dir // "lock"
 
 let init_logger ?verbosity (log_config : Node_config_file.log) =
-  let open Logging in
   begin
     match verbosity with
     | Some level ->
@@ -61,7 +60,7 @@ let init_logger ?verbosity (log_config : Node_config_file.log) =
               match Sys.getenv "LWT_LOG" with
               | rules -> Some rules
               | exception Not_found -> log_config.rules in
-        Utils.iter_option Lwt_log_core.load_rules rules
+        Utils.iter_option ~f:Lwt_log_core.load_rules rules
   end ;
   Logging.init ~template:log_config.template log_config.output
 
@@ -202,7 +201,7 @@ let run ?verbosity ?sandbox (config : Node_config_file.t) =
   lwt_log_notice "Shutting down the Tezos node..." >>= fun () ->
   Node.shutdown node >>= fun () ->
   lwt_log_notice "Shutting down the RPC server..." >>= fun () ->
-  Lwt_utils.may RPC_server.shutdown rpc >>= fun () ->
+  Lwt_utils.may ~f:RPC_server.shutdown rpc >>= fun () ->
   lwt_log_notice "BYE (%d)" x >>= fun () ->
   Logging.close () >>= fun () ->
   return ()

src/node/main/node_shared_arg.ml

@@ -8,7 +8,6 @@
 (**************************************************************************)
 
 open Cmdliner
-open P2p_types
 open Logging.Node.Main
 
 let (//) = Filename.concat
@@ -51,7 +50,7 @@ let wrap
 
   let rpc_tls =
     Utils.map_option
-      (fun (cert, key) -> { Node_config_file.cert ; key })
+      ~f:(fun (cert, key) -> { Node_config_file.cert ; key })
       rpc_tls in
 
   (* when `--expected-connections` is used,

src/node/main/node_shared_arg.mli

@@ -7,8 +7,6 @@
 (*                                                                        *)
 (**************************************************************************)
 
-open P2p_types
-
 type t = {
   data_dir: string option ;
   config_file: string ;

src/node/net/jbuild

@@ -4,7 +4,8 @@
  ((name node_net)
   (public_name tezos.node.net)
   (libraries (utils minutils conduit-lwt-unix cohttp cohttp-lwt-unix))
-  (flags (:standard -w +27-30-40@8
+  (flags (:standard -w -9+27-30-32-40@8
+                    -safe-string
                     -open Error_monad
                     -open Hash
                     -open Utils

src/node/net/p2p.ml

@@ -131,9 +131,9 @@ let may_create_discovery_worker _config pool =
 let create_maintenance_worker limits pool disco =
   let bounds =
     bounds
-      limits.min_connections
+      ~min:limits.min_connections
-      limits.expected_connections
+      ~expected:limits.expected_connections
-      limits.max_connections
+      ~max:limits.max_connections
   in
   P2p_maintenance.run
     ~connection_timeout:limits.authentification_timeout
@@ -214,7 +214,7 @@ module Real = struct
   let get_metadata { pool } conn =
     P2p_connection_pool.Peer_ids.get_metadata pool conn
 
-  let rec recv _net conn =
+  let recv _net conn =
     P2p_connection_pool.read conn >>=? fun msg ->
     lwt_debug "message read from %a"
       Connection_info.pp
@@ -611,7 +611,6 @@ module RPC = struct
            (opt "last_miss" Time.encoding))
 
     let info_of_point_info i =
-      let open P2p_connection_pool in
       let open P2p_connection_pool_types in
       let state = match Point_info.State.get i with
         | Requested _ -> Requested

src/node/net/p2p_connection.ml

@@ -238,7 +238,7 @@ module Reader = struct
     mutable worker: unit Lwt.t ;
   }
 
-  let rec read_message st init_mbytes =
+  let read_message st init_mbytes =
     let rec loop status =
       Lwt_unix.yield () >>= fun () ->
       let open Data_encoding.Binary in
@@ -306,8 +306,8 @@ module Reader = struct
     end ;
     st.worker <-
       Lwt_utils.worker "reader"
-        (fun () -> worker_loop st [])
+        ~run:(fun () -> worker_loop st [])
-        (fun () -> Canceler.cancel st.canceler) ;
+        ~cancel:(fun () -> Canceler.cancel st.canceler) ;
     st
 
   let shutdown st =
@@ -327,7 +327,7 @@ module Writer = struct
     binary_chunks_size: int ; (* in bytes *)
   }
 
-  let rec send_message st buf =
+  let send_message st buf =
     let rec loop = function
       | [] -> return ()
       | buf :: l ->
@@ -429,8 +429,8 @@ module Writer = struct
     end ;
     st.worker <-
       Lwt_utils.worker "writer"
-        (fun () -> worker_loop st)
+        ~run:(fun () -> worker_loop st)
-        (fun () -> Canceler.cancel st.canceler) ;
+        ~cancel:(fun () -> Canceler.cancel st.canceler) ;
     st
 
   let shutdown st =
@@ -480,9 +480,6 @@ let accept
   end ;
   return conn
 
-exception Not_available
-exception Connection_closed
-
 let catch_closed_pipe f =
   Lwt.catch f begin function
     | Lwt_pipe.Closed -> fail P2p_io_scheduler.Connection_closed

src/node/net/p2p_connection_pool.ml

@@ -140,8 +140,8 @@ module Answerer = struct
     } in
     st.worker <-
       Lwt_utils.worker "answerer"
-        (fun () -> worker_loop st)
+        ~run:(fun () -> worker_loop st)
-        (fun () -> Canceler.cancel canceler) ;
+        ~cancel:(fun () -> Canceler.cancel canceler) ;
     st
 
   let shutdown st =
@@ -682,8 +682,6 @@ let pool_stat { io_sched } =
 (***************************************************************************)
 
 type error += Rejected of Peer_id.t
-type error += Unexpected_point_state
-type error += Unexpected_peer_id_state
 type error += Pending_connection
 type error += Connected
 type error += Connection_closed = P2p_io_scheduler.Connection_closed
@@ -781,7 +779,7 @@ and authenticate pool ?point_info canceler fd point =
     if incoming then
       Point.Table.remove pool.incoming point
     else
-      iter_option Point_info.State.set_disconnected point_info ;
+      iter_option ~f:Point_info.State.set_disconnected point_info ;
     Lwt.return (Error err)
   end >>=? fun (info, auth_fd) ->
   (* Authentication correct! *)
@@ -857,7 +855,7 @@ and authenticate pool ?point_info canceler fd point =
         Lwt.return (Error err)
       end >>=? fun conn ->
       let id_point =
-        match info.id_point, map_option Point_info.point point_info with
+        match info.id_point, map_option ~f:Point_info.point point_info with
         | (addr, _), Some (_, port) -> addr, Some port
         | id_point, None ->  id_point in
       return

src/node/net/p2p_connection_pool.mli

@@ -337,7 +337,7 @@ module Log_event : sig
 
   type t =
 
-    (** Pool-level events *)
+    (* Pool-level events *)
 
     | Too_few_connections
     | Too_many_connections
@@ -347,10 +347,11 @@ module Log_event : sig
 
     | Gc_points
     (** Garbage collection of known point table has been triggered. *)
+
     | Gc_peer_ids
     (** Garbage collection of known peer_ids table has been triggered. *)
 
-    (** Connection-level events *)
+    (* Connection-level events *)
 
     | Incoming_connection of Point.t
     (** We accept(2)-ed an incoming connection *)

src/node/net/p2p_connection_pool_types.ml

@@ -300,7 +300,6 @@ module Peer_info = struct
       | External_disconnection
 
     let kind_encoding =
-      let open Data_encoding in
       Data_encoding.string_enum [
         "incoming_request", Accepting_request ;
         "rejecting_request", Rejecting_request ;

src/node/net/p2p_discovery.ml

@@ -7,7 +7,6 @@
 (*                                                                        *)
 (**************************************************************************)
 
-open P2p_types
 include Logging.Make (struct let name = "p2p.discovery" end)
 
 type t = ()

src/node/net/p2p_io_scheduler.ml

@@ -171,8 +171,8 @@ module Scheduler(IO : IO) = struct
     } in
     st.worker <-
       Lwt_utils.worker IO.name
-        (fun () -> worker_loop st)
+        ~run:(fun () -> worker_loop st)
-        (fun () -> Canceler.cancel st.canceler) ;
+        ~cancel:(fun () -> Canceler.cancel st.canceler) ;
     st
 
   let create_connection st in_param out_param canceler id =
@@ -418,7 +418,7 @@ let read_now conn ?pos ?len buf =
   | None ->
       try
         map_option
-          (read_from conn ?pos ?len buf)
+          ~f:(read_from conn ?pos ?len buf)
           (Lwt_pipe.pop_now conn.read_queue)
       with Lwt_pipe.Closed -> Some (Error [Connection_closed])
 

src/node/net/p2p_maintenance.ml

@@ -185,8 +185,8 @@ let run ~connection_timeout bounds pool disco =
   } in
   st.maintain_worker <-
     Lwt_utils.worker "maintenance"
-      (fun () -> worker_loop st)
+      ~run:(fun () -> worker_loop st)
-      (fun () -> Canceler.cancel canceler) ;
+      ~cancel:(fun () -> Canceler.cancel canceler) ;
   st
 
 let maintain { just_maintained ; please_maintain } =

src/node/net/p2p_types.ml

@@ -7,8 +7,6 @@
 (*                                                                        *)
 (**************************************************************************)
 
-open Logging.Net
-
 module Canceler = Lwt_utils.Canceler
 
 module Version = struct

src/node/net/p2p_welcome.ml

@@ -62,8 +62,8 @@ let run ~backlog pool ?addr port  =
     } in
     st.worker <-
       Lwt_utils.worker "welcome"
-        (fun () -> worker_loop st)
+        ~run:(fun () -> worker_loop st)
-        (fun () -> Canceler.cancel st.canceler) ;
+        ~cancel:(fun () -> Canceler.cancel st.canceler) ;
     Lwt.return st
   end begin fun exn ->
     lwt_log_error

src/node/shell/chain.ml

@@ -54,7 +54,7 @@ let locked_set_head chain_store data block =
     Lwt.return hash
   in
   Chain_traversal.new_blocks
-    data.current_head block >>= fun (ancestor, path) ->
+    ~from_block:data.current_head ~to_block:block >>= fun (ancestor, path) ->
   let ancestor = Block.hash ancestor in
   pop_blocks ancestor data.current_head >>= fun () ->
   Lwt_list.fold_left_s push_block ancestor path >>= fun _ ->

src/node/shell/distributed_db.ml

@@ -38,10 +38,6 @@ module Make_raw
      with type key := Hash.t
       and type value := Disk_table.value) = struct
 
-  type key = Hash.t
-  type value = Disk_table.value
-  type param = Disk_table.store
-
   module Request = struct
     type param = Request_message.param request_param
     let active { active } = active ()
@@ -73,7 +69,6 @@ end
 
 module Fake_operation_storage = struct
   type store = State.Net.t
-  type key = Operation_hash.t
   type value = Operation.t
   let known _ _ = Lwt.return_false
   let read _ _ = Lwt.return (Error_monad.error_exn Not_found)
@@ -98,7 +93,6 @@ module Raw_operation =
 
 module Block_header_storage = struct
   type store = State.Net.t
-  type key = Block_hash.t
   type value = Block_header.t
   let known = State.Block.known_valid
   let read net_state h =
@@ -106,7 +100,7 @@ module Block_header_storage = struct
     return (State.Block.header b)
   let read_opt net_state h =
     State.Block.read_opt net_state h >>= fun b ->
-    Lwt.return (Utils.map_option State.Block.header b)
+    Lwt.return (Utils.map_option ~f:State.Block.header b)
   let read_exn net_state h =
     State.Block.read_exn net_state h >>= fun b ->
     Lwt.return (State.Block.header b)
@@ -129,7 +123,6 @@ module Raw_block_header =
 
 module Operation_hashes_storage = struct
   type store = State.Net.t
-  type key = Block_hash.t * int
   type value = Operation_hash.t list
   let known net_state (h, _) = State.Block.known_valid net_state h
   let read net_state (h, i) =
@@ -207,7 +200,6 @@ end
 
 module Operations_storage = struct
   type store = State.Net.t
-  type key = Block_hash.t * int
   type value = Operation.t list
   let known net_state (h, _) = State.Block.known_valid net_state h
   let read net_state (h, i) =
@@ -276,7 +268,6 @@ end
 
 module Protocol_storage = struct
   type store = State.t
-  type key = Protocol_hash.t
   type value = Protocol.t
   let known = State.Protocol.known
   let read = State.Protocol.read
@@ -351,8 +342,6 @@ let db { global_db } = global_db
 
 module P2p_reader = struct
 
-  type t = p2p_reader
-
   let may_activate global_db state net_id f =
     match Net_id.Table.find state.peer_active_nets net_id with
     | net_db ->
@@ -858,11 +847,6 @@ let watch_protocol { protocol_db } =
   Raw_protocol.Table.watch protocol_db.table
 
 module Raw = struct
-  type 'a t =
-    | Bootstrap
-    | Advertise of P2p_types.Point.t list
-    | Message of 'a
-    | Disconnect
   let encoding = P2p.Raw.encoding Message.cfg.encoding
   let supported_versions = Message.cfg.versions
 end
@@ -902,7 +886,6 @@ module Make
   type t = Kind.t
   type key = Table.key
   type value = Table.value
-  type param = Table.param
   let known t k = Table.known (Kind.proj t) k
   type error += Missing_data = Table.Missing_data
   type error += Canceled = Table.Canceled

src/node/shell/distributed_db_functors.ml

@@ -323,7 +323,6 @@ end = struct
   include Logging.Make(struct let name = "node.distributed_db.scheduler." ^ Hash.name end)
 
   type key = Hash.t
-  type param = Request.param
 
   type t = {
     param: Request.param ;

src/node/shell/jbuild

@@ -4,7 +4,8 @@
  ((name node_shell)
   (public_name tezos.node.shell)
   (libraries (utils minutils node_net node_db node_updater ezjsonm ocplib-json-typed.bson))
-  (flags (:standard -w +27-30-40@8
+  (flags (:standard -w -9+27-30-32-40@8
+                    -safe-string
                     -open Error_monad
                     -open Hash
                     -open Utils

src/node/shell/node.ml

@@ -619,7 +619,7 @@ module RPC = struct
     let block_stream, stopper =
       Validator.new_head_watcher node.mainnet_validator in
     let first_run = ref true in
-    let rec next () =
+    let next () =
       if !first_run then begin
         first_run := false ;
         Chain.head node.mainnet_net >>= fun head ->

src/node/shell/prevalidator.ml

@@ -40,8 +40,6 @@ let list_pendings ~from_block ~to_block old_mempool =
 
 (** Worker *)
 
-exception Invalid_operation of Operation_hash.t
-
 open Prevalidation
 
 type t = {
@@ -73,7 +71,7 @@ let create net_db =
 
   Chain.head net_state >>= fun head ->
   let timestamp = ref (Time.now ()) in
-  (start_prevalidation head !timestamp () >|= ref) >>= fun validation_state ->
+  (start_prevalidation ~predecessor:head ~timestamp:!timestamp () >|= ref) >>= fun validation_state ->
   let pending = Operation_hash.Table.create 53 in
   let head = ref head in
   let operations = ref empty_result in
@@ -92,7 +90,7 @@ let create net_db =
     Lwt.return_unit in
 
   let reset_validation_state head timestamp =
-    start_prevalidation head timestamp () >>= fun state ->
+    start_prevalidation ~predecessor:head ~timestamp () >>= fun state ->
     validation_state := state;
     Lwt.return_unit in
 

src/node/shell/validator.ml

@@ -365,9 +365,6 @@ let apply_block net_state db
 
 module Context_db = struct
 
-    type key = Block_hash.t
-    type value = State.Block.t
-
     type data =
       { validator: net_validator ;
         state: [ `Inited of Block_header.t tzresult
@@ -608,7 +605,7 @@ module Context_db = struct
 end
 
 
-let rec create_validator ?parent worker ?max_child_ttl state db net =
+let create_validator ?parent worker ?max_child_ttl state db net =
 
   let net_id = State.Net.id net in
   let net_db = Distributed_db.activate db net in
@@ -776,8 +773,6 @@ let rec create_validator ?parent worker ?max_child_ttl state db net =
 
   Lwt.return v
 
-type error += Unknown_network of Net_id.t
-
 let create state db =
 
   let validators : net_validator Lwt.t Net_id.Table.t =

src/node/updater/jbuild

@@ -4,7 +4,8 @@
  ((name node_updater)
   (public_name tezos.node.updater)
   (libraries (utils minutils micheline tezos_protocol_compiler node_db dynlink))
-  (flags (:standard -w +27-30-40@8
+  (flags (:standard -w -9+27-30-32-40@8
+                    -safe-string
                     -open Error_monad
                     -open Hash
                     -open Utils

src/proto/alpha/jbuild

@@ -27,7 +27,7 @@ let () =
 (library
   ((name tezos_protocol_environment_alpha)
    (public_name tezos.protocol_environment.alpha)
-   (library_flags (:standard -linkall))
+   (library_flags (:standard -linkall -w -9 -safe-string))
    (libraries (node_updater))
    (modules (Environment))))
 
@@ -36,8 +36,8 @@ let () =
    (public_name tezos.embedded_raw_protocol.alpha)
    (libraries (tezos_protocol_environment_alpha))
    (library_flags (:standard -linkall))
-   (flags (:standard -nopervasives -nostdlib
+   (flags (:standard -nopervasives -nostdlib -safe-string
-                     -w +a-4-6-7-9-29-40..42-44-45-48
+                     -w +a-4-6-7-9-29-32-40..42-44-45-48
                      -warn-error -a+8
                      -open Tezos_protocol_environment_alpha__Environment
                      -open Error_monad
@@ -48,7 +48,7 @@ let () =
 (library
   ((name tezos_embedded_protocol_alpha)
    (public_name tezos.embedded_protocol.alpha)
-   (library_flags (:standard -linkall))
+   (library_flags (:standard -linkall -w -9-32 -safe-string))
    (libraries (tezos_embedded_raw_protocol_alpha node_shell))
    (modules (Registerer))))
 

src/proto/demo/jbuild

@@ -32,8 +32,8 @@
   ((name tezos_embedded_raw_protocol_demo)
    (libraries (tezos_protocol_environment_demo))
    (library_flags (:standard -linkall))
-   (flags (:standard -nopervasives -nostdlib
+   (flags (:standard -nopervasives -nostdlib -safe-string
-                     -w +a-4-6-7-9-29-40..42-44-45-48
+                     -w +a-4-6-7-9-29-32-40..42-44-45-48
                      -warn-error -a+8
                      -open Tezos_protocol_environment_demo__Environment
                      -open Error_monad
@@ -43,7 +43,7 @@
 
 (library
   ((name tezos_embedded_protocol_demo)
-   (library_flags (:standard -linkall))
+   (library_flags (:standard -linkall -w -9-32 -safe-string))
    (libraries (tezos_embedded_raw_protocol_demo node_shell))
    (modules (Registerer))))
 

src/proto/genesis/jbuild

@@ -25,15 +25,17 @@
 
 (library
   ((name tezos_protocol_environment_genesis)
+   (public_name tezos.protocol_environment.genesis)
   (libraries (node_updater))
   (modules (Environment))))
 
 (library
   ((name tezos_embedded_raw_protocol_genesis)
+   (public_name tezos.embedded_raw_protocol.genesis)
    (libraries (tezos_protocol_environment_genesis))
    (library_flags (:standard -linkall))
-   (flags (:standard -nopervasives -nostdlib
+   (flags (:standard -nopervasives -nostdlib -safe-string
-                     -w +a-4-6-7-9-29-40..42-44-45-48
+                     -w +a-4-6-7-9-29-32-40..42-44-45-48
                      -warn-error -a+8
                      -open Tezos_protocol_environment_genesis__Environment
                      -open Error_monad
@@ -43,7 +45,8 @@
 
 (library
   ((name tezos_embedded_protocol_genesis)
-   (library_flags (:standard -linkall))
+   (public_name tezos.embedded_protocol.genesis)
+   (library_flags (:standard -linkall -w -9-32 -safe-string))
    (libraries (tezos_embedded_raw_protocol_genesis node_shell))
    (modules (Registerer))))
 

src/utils/base58.ml

@@ -168,8 +168,8 @@ module MakeEncodings(E: sig
   let check_ambiguous_prefix prefix encodings =
     List.iter
       (fun (Encoding { encoded_prefix = s }) ->
-         if remove_prefix s prefix <> None ||
+         if remove_prefix ~prefix:s prefix <> None ||
-            remove_prefix prefix s <> None then
+            remove_prefix ~prefix s <> None then
            Format.ksprintf invalid_arg
              "Base58.register_encoding: duplicate prefix: %S, %S." s prefix)
       encodings

src/utils/cli_entries.ml

@@ -287,14 +287,14 @@ let command ?group ~desc options params handler =
 
 (* Param combinators *)
 let string ~name ~desc next =
-  param name desc { converter=(fun _ s -> return s) ; autocomplete=None } next
+  param ~name ~desc { converter=(fun _ s -> return s) ; autocomplete=None } next
 
 (* Help commands *)
 let help_group =
   { name = "man" ;
     title = "Access the documentation" }
 
-let rec string_contains ~needle ~haystack =
+let string_contains ~needle ~haystack =
   try
     Some (Str.search_forward (Str.regexp_string needle) haystack 0)
   with Not_found ->
@@ -539,7 +539,7 @@ let has_args : type a ctx. (a, ctx) args -> bool = function
   | NoArgs -> false
   | AddArg (_,_) -> true
 
-let rec print_options_brief (type ctx) =
+let print_options_brief (type ctx) =
   let help_option :
     type a. Format.formatter -> (a, ctx) arg -> unit =
     fun ppf -> function
@@ -631,7 +631,7 @@ let contains_params_args :
     in help params
 
 let print_command :
-  type a ctx ret. ?prefix: string -> ?highlights:string list -> Format.formatter -> (ctx, ret) command -> unit
+  type ctx ret. ?prefix: string -> ?highlights:string list -> Format.formatter -> (ctx, ret) command -> unit
   = fun ?(prefix = "") ?(highlights=[]) ppf (Command { params ; desc ; options=Argument { spec } }) ->
     if contains_params_args params spec
     then
@@ -686,7 +686,6 @@ let command_args_help ppf command =
     command
 
 let usage
-    (type ctx) (type ret)
     ppf
     ?global_options
     ~details
@@ -727,7 +726,7 @@ let usage
   Format.fprintf ppf "@]"
 
 let command_usage
-    (type ctx) (type ret) ppf commands =
+    ppf commands =
   let exe = Filename.basename Sys.executable_name in
   let prefix = exe ^ " [global options] " in
   Format.fprintf ppf

src/utils/cli_entries.mli

@@ -21,6 +21,7 @@ val parameter : ?autocomplete:('ctx -> string list tzresult Lwt.t) ->
 (** {2 Flags and Options } *)
 
 (** {3 Options and Switches } *)
+
 (** Type for option or switch *)
 type ('a, 'ctx) arg
 
@@ -37,6 +38,7 @@ val default_arg : doc:string -> parameter:string ->
   default:string ->
   ('p, 'ctx) parameter ->
   ('p, 'ctx) arg
+
 (** Create a boolean switch.
     The value will be set to [true] if the switch is provided and [false] if it is not. *)
 val switch : doc:string -> parameter:string ->
@@ -144,6 +146,7 @@ val prefix:
   string ->
   ('a, 'ctx, 'ret) params ->
   ('a, 'ctx, 'ret) params
+
 (** Multiple words given in sequence for a command line *)
 val prefixes:
   string list ->
@@ -154,6 +157,7 @@ val prefixes:
 val fixed:
   string list ->
   ('ctx -> 'ret tzresult Lwt.t, 'ctx, 'ret) params
+
 (** End the description of the command line *)
 val stop:
   ('ctx -> 'ret tzresult Lwt.t, 'ctx, 'ret) params

src/utils/crypto_box.ml

@@ -7,8 +7,6 @@
 (*                                                                        *)
 (**************************************************************************)
 
-open Utils
-
 (** Tezos - X25519/XSalsa20-Poly1305 cryptography *)
 
 type secret_key = Sodium.Box.secret_key
@@ -16,7 +14,6 @@ type public_key = Sodium.Box.public_key
 type channel_key = Sodium.Box.channel_key
 type nonce = Sodium.Box.nonce
 type target = Z.t
-exception TargetNot256Bit
 
 module Public_key_hash = Hash.Make_Blake2B (Base58) (struct
     let name = "Crypto_box.Public_key_hash"

src/utils/error_monad.ml

@@ -40,8 +40,6 @@ module Make() = struct
           pp: Format.formatter -> 'err -> unit ; } ->
       error_kind
 
-  type registred_errors = error_kind list
-
   let error_kinds
     : error_kind list ref
     = ref []
@@ -281,7 +279,7 @@ module Make() = struct
             filter_map_s f t >>=? fun rt ->
             return (rh :: rt)
 
-  let rec filter_map_p f l =
+  let filter_map_p f l =
     match l with
     | [] -> return []
     | h :: t ->

src/utils/hash.ml

@@ -7,14 +7,11 @@
 (*                                                                        *)
 (**************************************************************************)
 
-open Error_monad
-
 let (//) = Filename.concat
 let (>>=) = Lwt.bind
 let (>|=) = Lwt.(>|=)
 
 open Error_monad
-open Utils
 
 let () =
   let expected_primitive = "blake2b"
@@ -549,7 +546,6 @@ module Generic_hash =
 module Net_id = struct
 
   type t = string
-  type net_id = t
 
   let name = "Net_id"
   let title = "Network identifier"

src/utils/jbuild

@@ -18,7 +18,7 @@
     ;; Internal
     minutils
     ))
-  (flags (:standard -w +27-30-40@8))
+  (flags (:standard -w -9+27-30-32-40@8 -safe-string))
   (wrapped false)))
 
 

src/utils/lwt_dropbox.ml

@@ -30,7 +30,7 @@ let notify_put dropbox =
       dropbox.put_waiter <- None ;
       Lwt.wakeup_later w ()
 
-let rec put dropbox elt =
+let put dropbox elt =
   if dropbox.closed then
     raise Closed
   else begin

src/utils/lwt_pipe.ml

@@ -91,7 +91,7 @@ let rec push ({ closed ; queue ; current_size ;
     wait_pop q >>= fun () ->
     push q elt
 
-let rec push_now ({ closed ; queue ; compute_size ;
+let push_now ({ closed ; queue ; compute_size ;
                 current_size ; max_size
               } as q) elt =
   if closed then raise Closed ;

src/utils/lwt_utils.ml

@@ -358,7 +358,7 @@ let stable_sort cmp l =
 
 let sort = stable_sort
 
-let rec read_bytes ?(pos = 0) ?len fd buf =
+let read_bytes ?(pos = 0) ?len fd buf =
   let len = match len with None -> Bytes.length buf - pos | Some l -> l in
   let rec inner pos len =
     if len = 0 then

src/utils/time.ml

@@ -7,7 +7,6 @@
 (*                                                                        *)
 (**************************************************************************)
 
-open Error_monad
 open CalendarLib
 
 module T = struct

test/lib/jbuild

@@ -3,4 +3,5 @@
 (library
  ((name test_lib)
   (libraries (kaputt utils minutils))
-  (wrapped false)))
+  (wrapped false)
+  (flags (:standard -w -9-32 -safe-string))))

test/lib/node_helpers.ml

@@ -38,7 +38,7 @@ let fork_node ?(timeout = 4) ?(port = 18732) ?sandbox () =
   let null_fd = Unix.(openfile "/dev/null" [O_RDONLY] 0o644) in
   let exe =
     let (//) = Filename.concat in
-    Filename.(Sys.getcwd () // ".." // "src" // "node_main.exe") in
+    Sys.getcwd () // ".." // "src" // "node_main.exe" in
   let pid =
     Unix.create_process exe
       [| "tezos-node" ;

test/p2p/jbuild

@@ -5,7 +5,9 @@
           test_p2p_connection_pool
           test_p2p_io_scheduler))
   (libraries (minutils utils test_lib node_net))
-  (flags (:standard -linkall
+  (flags (:standard -w -9-32
+                    -linkall
+                    -safe-string
                     -open Error_monad
                     -open Hash
                     -open Utils

test/p2p/test_p2p_connection.ml

@@ -370,7 +370,6 @@ let spec = Arg.[
   ]
 
 let main () =
-  let open Utils in
   let anon_fun _num_peers = raise (Arg.Bad "No anonymous argument.") in
   let usage_msg = "Usage: %s.\nArguments are:" in
   Arg.parse spec anon_fun usage_msg ;

test/proto_alpha/jbuild

@@ -10,7 +10,8 @@
               client_lib
               client_embedded_genesis
               client_embedded_alpha))
-  (flags (:standard -open Error_monad
+  (flags (:standard -w -9-32 -safe-string
+                    -open Error_monad
                     -open Hash
                     -open Tezos_data
                     -open Tezos_protocol_environment_alpha

test/proto_alpha/proto_alpha_helpers.mli

@@ -171,6 +171,7 @@ module Assert : sig
   val unknown_contract : msg:string -> 'a tzresult -> unit
   (** [unknown_contract ~msg result] raises if result is not a
       [Storage_error]. *)
+
   val non_existing_contract : msg:string -> 'a tzresult -> unit
   val balance_too_low : msg:string -> 'a tzresult -> unit
   val non_spendable : msg:string -> 'a tzresult -> unit

test/shell/jbuild

@@ -11,7 +11,9 @@
               tezos_embedded_protocol_demo
               tezos_embedded_protocol_alpha
               tezos_embedded_protocol_genesis))
-  (flags (:standard -open Error_monad
+  (flags (:standard -w -9-32
+                    -safe-string
+                    -open Error_monad
                     -open Hash
                     -open Utils
                     -open Tezos_data))))

test/shell/test_context.ml

@@ -93,7 +93,7 @@ type t = {
 
 let wrap_context_init f base_dir =
   let root = base_dir // "context" in
-  Context.init root >>= fun idx ->
+  Context.init ~root ?patch_context:None >>= fun idx ->
   Context.commit_genesis idx
     ~net_id
     ~time:genesis.time

test/shell/test_store.ml

@@ -217,7 +217,6 @@ let test_hashset (type t)
       (Make_substore(Store)(struct let name = ["test_set"] end))
       (Block_hash)
       (BlockSet) in
-  let open BlockSet in
   let bhset : BlockSet.t = BlockSet.add bh2 (BlockSet.add bh1 BlockSet.empty) in
   StoreSet.store_all s bhset >>= fun () ->
   StoreSet.read_all s >>= fun bhset' ->
@@ -227,8 +226,8 @@ let test_hashset (type t)
   StoreSet.store_all s bhset2 >>= fun () ->
   StoreSet.read_all s >>= fun bhset2' ->
   Assert.equal_block_set ~msg:__LOC__ bhset2 bhset2' ;
-  StoreSet.fold s BlockSet.empty
+  StoreSet.fold s ~init:BlockSet.empty
-    (fun bh acc -> Lwt.return (BlockSet.add bh acc)) >>= fun bhset2'' ->
+    ~f:(fun bh acc -> Lwt.return (BlockSet.add bh acc)) >>= fun bhset2'' ->
   Assert.equal_block_set ~msg:__LOC__ bhset2 bhset2'' ;
   Store.store s ["day";"current"] (MBytes.of_string "Mercredi") >>= fun () ->
   StoreSet.remove_all s >>= fun () ->

test/utils/jbuild

@@ -7,7 +7,9 @@
           test_stream_data_encoding
           test_utils))
   (libraries (minutils utils test_lib))
-  (flags (:standard -open Error_monad
+  (flags (:standard -w -9-32
+                    -safe-string
+                    -open Error_monad
                     -open Hash
                     -open Utils
                     -open Tezos_data))))

test/utils/test_data_encoding.ml

@@ -1,5 +1,4 @@
 open Data_encoding
-open Hash
 open Error_monad
 
 let (>>=) = Lwt.bind

test/utils/test_merkle.ml

@@ -8,7 +8,6 @@
 (**************************************************************************)
 
 open Error_monad
-open Hash
 
 let rec (--) i j =
   if j < i then []

test/utils/test_stream_data_encoding.ml

@@ -1,5 +1,4 @@
 open Data_encoding
-open Hash
 open Error_monad
 
 let (>>=) = Lwt.bind
@@ -22,7 +21,7 @@ let rec fold_left_pending f accu l =
   | a::l -> fold_left_pending f (f accu a l) l
 
 let test_read_simple_bin_ko_invalid_data
-    ?msg ?(not_equal=Assert.not_equal) encoding value =
+    ?(not_equal=Assert.not_equal) encoding value =
   let len_data = MBytes.length (Binary.to_bytes encoding value) in
   if classify encoding != `Variable && len_data > 0 then
     for sz = 1 to len_data do
@@ -64,14 +63,14 @@ let test_read_simple_bin_ko_invalid_data
 let unexpected loc =
   loc ^ ": This case should not happen"
 
-let test_read_simple_bin_ko_await ?msg encoding value =
+let test_read_simple_bin_ko_await encoding value =
   let len_data = MBytes.length (Binary.to_bytes encoding value) in
   if classify encoding != `Variable && len_data > 0 then
     for sz = 1 to len_data do
       let l = Binary.to_bytes_list sz encoding value in
       match List.rev l with
       | [] -> Assert.fail_msg "%s" (unexpected __LOC__)
-      | e::r ->
+      | _ :: r ->
           let l = List.rev r in (* last mbyte removed !! *)
           ignore(
             fold_left_pending
@@ -96,7 +95,7 @@ let test_read_simple_bin_ko_await ?msg encoding value =
                    | Binary.Error ->
                        if not (classify encoding == `Variable) then
                          Assert.fail_msg "%s" (unexpected __LOC__)
-                   | Binary.Success result ->
+                   | Binary.Success _ ->
                        Assert.fail_msg "%s" (unexpected __LOC__)
                  end;
                  _done
@@ -139,7 +138,7 @@ let test_read_simple_bin_ok ?msg ?(equal=Assert.equal) encoding value =
   done
 
 let test_check_simple_bin_ko_invalid_data
-    ?msg ?(not_equal=Assert.not_equal) encoding value =
+    encoding value =
   let len_data = MBytes.length (Binary.to_bytes encoding value) in
   if classify encoding != `Variable && len_data > 0 then
     for sz = 1 to len_data do
@@ -168,7 +167,7 @@ let test_check_simple_bin_ko_invalid_data
                match status with
                | Binary.Await _ -> ()
                | Binary.Error -> ()
-               | Binary.Success {res; remaining} ->
+               | Binary.Success { remaining } ->
                    Assert.equal ~msg:__LOC__ remaining [];
                    (* res is unit for check *)
              end;
@@ -177,14 +176,14 @@ let test_check_simple_bin_ko_invalid_data
       )
     done
 
-let test_check_simple_bin_ko_await ?msg encoding value =
+let test_check_simple_bin_ko_await encoding value =
   let len_data = MBytes.length (Binary.to_bytes encoding value) in
   if classify encoding != `Variable && len_data > 0 then
     for sz = 1 to len_data do
       let l = Binary.to_bytes_list sz encoding value in
       match List.rev l with
       | [] -> Assert.fail_msg "%s" (unexpected __LOC__)
-      | e::r ->
+      | _ :: r ->
           let l = List.rev r in (* last mbyte removed !! *)
           ignore(
             fold_left_pending
@@ -209,7 +208,7 @@ let test_check_simple_bin_ko_await ?msg encoding value =
                    | Binary.Error ->
                        if not (classify encoding == `Variable) then
                          Assert.fail_msg "%s" (unexpected __LOC__)
-                   | Binary.Success result ->
+                   | Binary.Success _ ->
                        Assert.fail_msg "%s" (unexpected __LOC__)
                  end;
                  _done
@@ -217,7 +216,7 @@ let test_check_simple_bin_ko_await ?msg encoding value =
           )
     done
 
-let test_check_simple_bin_ok ?msg ?(equal=Assert.equal) encoding value =
+let test_check_simple_bin_ok encoding value =
   let len_data = max 1 (MBytes.length (Binary.to_bytes encoding value)) in
   for sz = 1 to len_data do
     ignore(
@@ -238,7 +237,7 @@ let test_check_simple_bin_ok ?msg ?(equal=Assert.equal) encoding value =
                  )status _todo
              in
              match status with
-             | Binary.Success {res; remaining} ->
+             | Binary.Success { remaining } ->
                  Assert.equal ~msg:__LOC__ remaining [];
                  (* res is unit for check *)
              | Binary.Await _ -> Assert.fail_msg "%s" (unexpected __LOC__)
@@ -254,15 +253,14 @@ let test_check_simple_bin_ok ?msg ?(equal=Assert.equal) encoding value =
 let test_simple
     ~msg ?(equal=Assert.equal) ?(not_equal=Assert.not_equal) enc value
   =
-  test_check_simple_bin_ok ~msg:(msg ^ ": binary-ok") ~equal enc value;
+  test_check_simple_bin_ok enc value;
-  test_check_simple_bin_ko_await ~msg:(msg ^ ": binary-ko_await") enc value;
+  test_check_simple_bin_ko_await enc value;
-  test_check_simple_bin_ko_invalid_data
+  test_check_simple_bin_ko_invalid_data enc value;
-    ~msg:(msg ^ ": binary-invalid_data") ~not_equal enc value;
 
   test_read_simple_bin_ok ~msg:(msg ^ ": binary-ok") ~equal enc value;
-  test_read_simple_bin_ko_await ~msg:(msg ^ ": binary-ko_await") enc value;
+  test_read_simple_bin_ko_await enc value;
   test_read_simple_bin_ko_invalid_data
-    ~msg:(msg ^ ": binary-invalid_data") ~not_equal enc value
+    ~not_equal enc value
 
 
 

test/utils/test_utils.ml

@@ -8,7 +8,6 @@
 (**************************************************************************)
 
 open Error_monad
-open Hash
 
 let rec (--) i j =
   if j < i then []