Compiler: allow bytecode compilation

Makefile

@@ -6,13 +6,13 @@ all:
 		src/bin_node/main.exe \
 		src/bin_client/main.exe \
 		src/bin_client/admin_main.exe \
-		src/lib_protocol_compiler/main.exe
+		src/lib_protocol_compiler/main_native.exe
 	@cp _build/default/src/bin_node/main.exe tezos-node
 	@cp _build/default/src/bin_client/main.exe tezos-client
 	@cp _build/default/src/bin_client/admin_main.exe tezos-admin-client
-	@cp _build/default/src/lib_protocol_compiler/main.exe tezos-protocol-compiler
+	@cp _build/default/src/lib_protocol_compiler/main_native.exe tezos-protocol-compiler
 
-%.pkg:
+tezos-%.pkg:
 	@jbuilder build --dev $(patsubst %.opam,%.install, \
 				   $(shell find -name tezos-$*.opam))
 

src/bin_node/main.ml

@@ -10,7 +10,8 @@
 let () =
   if Filename.basename Sys.argv.(0) = Updater.compiler_name then begin
     try
-      Tezos_protocol_compiler.Native.main ();
+      Tezos_protocol_compiler.Compiler.main
+        Tezos_protocol_compiler_native.Native.driver ;
       Pervasives.exit 0
     with exn ->
       Format.eprintf "%a\n%!" Opterrors.report_error exn;

src/lib_protocol_compiler/byte.ml

@@ -0,0 +1,46 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** The OCaml compiler not being implemented with Lwt, the compilation
+    take place in a separated process (by using [Lwt_process.exec]).
+
+    The [main] function is the entry point for the forked process.
+    While [Updater.compile] is the 'forking' function to be called by
+    the [tezos-node] process.
+
+*)
+
+(** Semi-generic compilation functions *)
+
+let pack_objects output objects =
+  let output = output ^ ".cmo" in
+  Compmisc.init_path true;
+  Bytepackager.package_files
+    Format.err_formatter Env.initial_safe_string objects output ;
+  Warnings.check_fatal () ;
+  output
+
+let link_shared output objects =
+  Compenv.(readenv Format.err_formatter Before_link) ;
+  Compmisc.init_path true;
+  Bytelink.link Format.err_formatter objects output ;
+  Warnings.check_fatal ()
+
+let compile_ml ?for_pack ml =
+  let target = Filename.chop_extension ml in
+  Clflags.for_package := for_pack ;
+  Compenv.(readenv Format.err_formatter (Before_compile ml));
+  Compile.implementation Format.err_formatter ml target ;
+  Clflags.for_package := None ;
+  target ^ ".cmo"
+
+let () =
+  Clflags.native_code := false
+
+let driver = Compiler.{ compile_ml ; link_shared ; pack_objects }

src/lib_protocol_compiler/byte.mli

@@ -0,0 +1,10 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+val driver: Compiler.driver

src/lib_protocol_compiler/compiler.ml

@@ -0,0 +1,235 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+let warnings = "+a-4-6-7-9-29-40..42-44-45-48"
+let warn_error = "-a+8"
+
+let () =
+  Clflags.unsafe_string := false
+
+(** Override the default 'Env.Persistent_signature.load'
+    with a lookup in locally defined hashtable.
+*)
+
+let preloaded_cmis : (string, Env.Persistent_signature.t) Hashtbl.t =
+  Hashtbl.create ~random:true 42
+
+(* Set hook *)
+let () =
+  Env.Persistent_signature.load :=
+    (fun ~unit_name ->
+       try Some (Hashtbl.find preloaded_cmis (String.capitalize_ascii unit_name))
+       with Not_found -> None)
+
+let load_cmi_from_file file =
+  Hashtbl.add preloaded_cmis
+    (String.capitalize_ascii Filename.(basename (chop_extension file)))
+    { filename = file ;
+      cmi = Cmi_format.read_cmi file ;
+    }
+
+let load_embeded_cmi (unit_name, content) =
+  let content = Bytes.of_string content in
+  (* Read cmi magic *)
+  let magic_len = String.length Config.cmi_magic_number in
+  let magic = Bytes.sub content 0 magic_len in
+  assert (magic = Bytes.of_string Config.cmi_magic_number) ;
+  (* Read cmi_name and cmi_sign *)
+  let pos = magic_len in
+  let (cmi_name, cmi_sign) = Marshal.from_bytes content pos in
+  let pos = pos + Marshal.total_size content pos in
+  (* Read cmi_crcs *)
+  let cmi_crcs = Marshal.from_bytes content pos in
+  let pos = pos + Marshal.total_size content pos  in
+  (* Read cmi_flags *)
+  let cmi_flags = Marshal.from_bytes content pos in
+  (* TODO check crcrs... *)
+  Hashtbl.add
+    preloaded_cmis
+    (String.capitalize_ascii unit_name)
+    { filename  =  unit_name ^ ".cmi" ;
+      cmi = { cmi_name; cmi_sign; cmi_crcs; cmi_flags } ;
+    }
+
+let load_embeded_cmis cmis = List.iter load_embeded_cmi cmis
+
+(** Compilation environment.
+
+    [tezos_protocol_env] defines the list of [cmi] available while compiling
+    the protocol version. The [cmi] are packed into the [tezos-node]
+    binary by using [ocp-ocamlres], see the Makefile.
+
+    [register_env] defines a complementary list of [cmi] available
+    while compiling the generated [register.ml] file (that register
+    the protocol first-class module into the [Updater.versions]
+    hashtable).
+
+*)
+
+
+let tezos_protocol_env =
+  let open Embedded_cmis in
+  [
+    "CamlinternalFormatBasics", camlinternalFormatBasics_cmi ;
+    "Tezos_protocol_environment_sigs", tezos_protocol_environment_sigs_cmi ;
+    "Tezos_protocol_environment_sigs__V1", tezos_protocol_environment_sigs__V1_cmi ;
+  ]
+
+let register_env =
+  let open Embedded_cmis in
+  [
+    "tezos_protocol_registerer__Registerer", tezos_protocol_registerer__Registerer_cmi ;
+  ]
+
+
+(** Helpers *)
+
+let (//) = Filename.concat
+
+let create_file ?(perm = 0o644) name content =
+  let open Unix in
+  let fd = openfile name [O_TRUNC; O_CREAT; O_WRONLY] perm in
+  ignore(write_substring fd content 0 (String.length content));
+  close fd
+
+let safe_unlink file =
+  try Unix.unlink file
+  with Unix.Unix_error(Unix.ENOENT, _, _) -> ()
+
+let unlink_cmi dir (file, _) =
+  safe_unlink (dir // file ^ ".cmi")
+
+let unlink_object obj =
+  safe_unlink obj;
+  safe_unlink (Filename.chop_suffix obj ".cmx" ^ ".cmi");
+  safe_unlink (Filename.chop_suffix obj ".cmx" ^ ".o")
+
+let debug_flag = ref false
+
+let debug fmt =
+  if !debug_flag then Format.eprintf fmt
+  else Format.ifprintf Format.err_formatter fmt
+
+let hash_file file =
+  let open Sodium.Generichash in
+  let buflen = 8092 in
+  let buf = BytesLabels.create buflen in
+  let fd = Unix.openfile file [Unix.O_RDONLY] 0o600 in
+  let state = init ~size:32 () in
+  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 ~pos:0 ~len:nb_read
+  in
+  loop () ;
+  Unix.close fd ;
+  BytesLabels.unsafe_to_string (Bytes.of_hash (final state))
+
+let mktemp_dir () =
+  Filename.get_temp_dir_name () //
+  Printf.sprintf "tezos-protocol-build-%06X" (Random.int 0xFFFFFF)
+
+(** Main *)
+
+type driver = {
+  compile_ml: ?for_pack:string -> string -> string ;
+  pack_objects: string -> string list -> string ;
+  link_shared: string -> string list -> unit ;
+}
+
+let main { compile_ml ; pack_objects ; link_shared } =
+  Random.self_init () ;
+  let anonymous = ref []
+  and static = ref false
+  and register = ref false
+  and build_dir = ref None in
+  let args_spec = [
+    "-static", Arg.Set static, " Only build the static library (no .cmxs)";
+    "-register", Arg.Set register, " Generete the `Registerer` module";
+    "-bin-annot", Arg.Set Clflags.binary_annotations, " (see ocamlopt)" ;
+    "-g", Arg.Set Clflags.debug, " (see ocamlopt)" ;
+    "-build-dir", Arg.String (fun s -> build_dir := Some s),
+    "use custom build directory and preserve build artifacts"
+  ] in
+  let usage_msg =
+    Printf.sprintf
+      "Usage: %s [options] <out> <srcdir>\nOptions are:"
+      Sys.argv.(0) in
+  Arg.parse args_spec (fun s -> anonymous := s :: !anonymous) usage_msg ;
+  let (output, source_dir) =
+    match List.rev !anonymous with
+    | [ output ; protocol_dir ] -> output, protocol_dir
+    | _ -> Arg.usage args_spec usage_msg ; Pervasives.exit 1 in
+  let build_dir =
+    match !build_dir with
+    | None ->
+        let dir = mktemp_dir () in
+        at_exit (fun () -> Lwt_main.run (Lwt_utils.remove_dir dir)) ;
+        dir
+    | Some dir -> dir in
+  Lwt_main.run (Lwt_utils.create_dir ~perm:0o755 build_dir) ;
+  Lwt_main.run (Lwt_utils.create_dir ~perm:0o755 (Filename.dirname output)) ;
+  let hash, protocol = Protocol.read_dir source_dir in
+  (* Generate the 'functor' *)
+  let functor_file = build_dir // "functor.ml" in
+  let oc = open_out functor_file in
+  Packer.dump oc
+    (Array.map
+       begin fun { Protocol.name }  ->
+         let name_lowercase = String.uncapitalize_ascii name in
+         source_dir // name_lowercase ^ ".ml"
+       end
+       (Array.of_list protocol.components)) ;
+  close_out oc ;
+  (* Compile the protocol *)
+  let proto_cmi = Filename.chop_extension functor_file ^ ".cmi" in
+  let functor_unit =
+    String.capitalize_ascii
+      Filename.(basename (chop_extension functor_file)) in
+  let for_pack = String.capitalize_ascii (Filename.basename output) in
+  (* Initialize the compilers *)
+  Compenv.(readenv Format.err_formatter Before_args);
+  Clflags.nopervasives := true;
+  Clflags.no_std_include := true ;
+  Clflags.include_dirs := [Filename.dirname functor_file] ;
+  Warnings.parse_options false warnings ;
+  Warnings.parse_options true warn_error ;
+
+  load_embeded_cmis tezos_protocol_env ;
+  let packed_protocol_object = compile_ml ~for_pack functor_file in
+
+  let register_objects =
+    if not !register then
+      []
+    else begin
+      load_embeded_cmis register_env ;
+      load_cmi_from_file proto_cmi ;
+      (* Compiler the 'registering module' *)
+      let register_file = Filename.dirname functor_file // "register.ml" in
+      create_file register_file
+        (Printf.sprintf
+           "module Name = struct let name = %S end\n\
+           \ let () = Tezos_protocol_compiler_native__Registerer.register Name.name (module %s.Make)"
+           (Protocol_hash.to_b58check hash)
+           functor_unit) ;
+      let register_object = compile_ml ~for_pack register_file in
+      [ register_object ]
+    end
+  in
+
+  let resulting_object =
+    pack_objects output (packed_protocol_object :: register_objects) in
+
+  (* Create the final [cmxs] *)
+  if not !static then begin
+    Clflags.link_everything := true ;
+    link_shared (output ^ ".cmxs") [resulting_object] ;
+  end

src/lib_protocol_compiler/embedded_cmis.mli

@@ -10,4 +10,4 @@
 val camlinternalFormatBasics_cmi: string
 val tezos_protocol_environment_sigs_cmi: string
 val tezos_protocol_environment_sigs__V1_cmi: string
-val tezos_protocol_compiler__Registerer_cmi: string
+val tezos_protocol_registerer__Registerer_cmi: string

src/lib_protocol_compiler/jbuild

@@ -5,34 +5,75 @@
   (action
     (run ${bin:ocp-ocamlres} -format ocaml -o ${@}
            ${lib:stdlib:camlinternalFormatBasics.cmi}
-           ${path:tezos_protocol_compiler__Registerer.cmi}
+           ${path:tezos_protocol_registerer__Registerer.cmi}
            ${lib:tezos-protocol-environment-sigs:tezos_protocol_environment_sigs.cmi}
            ${lib:tezos-protocol-environment-sigs:tezos_protocol_environment_sigs__V1.cmi}))))
 
+(library
+ ((name tezos_protocol_registerer)
+  (public_name tezos-protocol-compiler.registerer)
+  (libraries (tezos-base
+              tezos-protocol-environment-sigs))
+  (flags (:standard -w -9+27-30-32-40@8
+                    -safe-string
+                    -opaque
+                    -open Tezos_base__TzPervasives))
+  (modules (Registerer))))
+
 (library
  ((name tezos_protocol_compiler)
   (public_name tezos-protocol-compiler)
   (libraries (tezos-base
               tezos-protocol-environment-sigs
               compiler-libs
-              compiler-libs.optcomp
               lwt.unix
               ocplib-endian
               ocplib-ocamlres
               unix))
   (flags (:standard -w -9+27-30-32-40@8
                     -safe-string
-                    -opaque
                     -open Tezos_base__TzPervasives))
-  (modules (:standard \ Main Main_embedded_packer))))
+  (modules (Embedded_cmis Packer Compiler))))
+
+(library
+ ((name tezos_protocol_compiler_byte)
+  (public_name tezos-protocol-compiler.byte)
+  (libraries (tezos-base
+              tezos-protocol-compiler
+              compiler-libs.bytecomp))
+  (flags (:standard -w -9+27-30-32-40@8
+                    -safe-string
+                    -open Tezos_base__TzPervasives
+                    -open Tezos_protocol_compiler))
+  (modules (Byte))))
+
+(library
+ ((name tezos_protocol_compiler_native)
+  (public_name tezos-protocol-compiler.native)
+  (libraries (tezos-base
+              tezos-protocol-compiler
+              compiler-libs.optcomp))
+  (flags (:standard -w -9+27-30-32-40@8
+                    -safe-string
+                    -open Tezos_base__TzPervasives
+                    -open Tezos_protocol_compiler))
+  (modules (Native))))
 
 (executable
- ((name main)
+ ((name main_byte)
+  (public_name tezos-protocol-compiler-byte)
+  (modes (native))
+  (libraries (tezos_protocol_compiler_byte))
+  (flags (:standard -linkall))
+  (modules (Main_byte))))
+
+(executable
+ ((name main_native)
   (public_name tezos-protocol-compiler)
   (modes (native))
-  (libraries (tezos_protocol_compiler))
+  (libraries (tezos_protocol_compiler_native))
   (flags (:standard -linkall))
-  (modules (Main))))
+  (modules (Main_native))))
 
 (executable
  ((name main_embedded_packer)
@@ -55,9 +96,12 @@
   (deps ("embedded_cmis.mli"
          "main_embedded_packer.ml"
          "main_embedded_packer.mli"
-         "main.ml"
+         "main_byte.ml"
+         "main_native.ml"
          "native.ml"
          "native.mli"
+         "byte.ml"
+         "byte.mli"
          "packer.ml"
          "packer.mli"
          "registerer.ml"

src/lib_protocol_compiler/jbuild_protocol_template

@@ -55,6 +55,16 @@ let () = Format.kasprintf Jbuild_plugin.V1.send {|
 
 (jbuild_version 1)
 
+(rule
+ ((targets (tezos_protocol_%s.cmo
+            tezos_protocol_%s_dummy_byte.ml))
+  (deps ((glob_files src/*.ml)
+         (glob_files src/*.mli)
+         src/TEZOS_PROTOCOL))
+  (action (with-stdout-to ${path-no-dep:tezos_protocol_%s_dummy_byte.ml}
+           (chdir ${ROOT}
+                  (run ${bin:tezos-protocol-compiler-byte} -static ${path-no-dep:tezos_protocol_%s} ${path-no-dep:src}))))))
+
 (rule
  ((targets (tezos_protocol_%s.o
             tezos_protocol_%s.cmx
@@ -76,6 +86,15 @@ let () = Format.kasprintf Jbuild_plugin.V1.send {|
   (modes (native))
   (modules (Tezos_protocol_%s_dummy))))
 
+(library
+ ((name tezos_protocol_%s_byte)
+  (public_name tezos-protocol-%s.byte)
+  (library_flags (:standard -linkall %s/tezos_protocol_%s.cmo))
+  (flags (:standard -safe-string))
+  (wrapped false)
+  (modes (byte))
+  (modules (Tezos_protocol_%s_dummy_byte))))
+
 (install
   ((section lib)
    (files   ("tezos_protocol_%s.cmx" "tezos_protocol_%s.cmi"))
@@ -91,8 +110,13 @@ let () = Format.kasprintf Jbuild_plugin.V1.send {|
   (action (run bash ${libexec:tezos-stdlib:test-ocp-indent.sh} ${^}))))
 
 |}
-    version version version version version version version version
-    path
-    version version version version version version
+    version version version version
+    version version version version
+    version version version version
+    path version
+    version version version
+    path version
+    version version version
+    version version
     Format.(pp_print_list (fun ppf -> Format.fprintf ppf "%S"))
     sources

src/lib_protocol_compiler/main_byte.ml

@@ -0,0 +1,17 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+let () =
+  try
+    Tezos_protocol_compiler.Compiler.main
+      Tezos_protocol_compiler_byte.Byte.driver ;
+    Pervasives.exit 0
+  with exn ->
+    Format.eprintf "%a\n%!" Errors.report_error exn;
+    Pervasives.exit 1

src/lib_protocol_compiler/main_native.ml

@@ -9,7 +9,8 @@
 
 let () =
   try
-    Tezos_protocol_compiler.Native.main ();
+    Tezos_protocol_compiler.Compiler.main
+      Tezos_protocol_compiler_native.Native.driver ;
     Pervasives.exit 0
   with exn ->
     Format.eprintf "%a\n%!" Opterrors.report_error exn;

src/lib_protocol_compiler/native.ml

@@ -16,6 +16,8 @@
 
 *)
 
+open Compiler
+
 (* TODO: fail in the presence of "external" *)
 
 module Backend = struct
@@ -37,133 +39,6 @@ end
 
 let backend = (module Backend : Backend_intf.S)
 
-let warnings = "+a-4-6-7-9-29-40..42-44-45-48"
-let warn_error = "-a+8"
-
-let () =
-  Clflags.unsafe_string := false ;
-  Clflags.native_code := true
-
-(** Override the default 'Env.Persistent_signature.load'
-    with a lookup in locally defined hashtable.
-*)
-
-let preloaded_cmis : (string, Env.Persistent_signature.t) Hashtbl.t =
-  Hashtbl.create ~random:true 42
-
-(* Set hook *)
-let () =
-  Env.Persistent_signature.load :=
-    (fun ~unit_name ->
-       try Some (Hashtbl.find preloaded_cmis (String.capitalize_ascii unit_name))
-       with Not_found -> None)
-
-let load_cmi_from_file file =
-  Hashtbl.add preloaded_cmis
-    (String.capitalize_ascii Filename.(basename (chop_extension file)))
-    { filename = file ;
-      cmi = Cmi_format.read_cmi file ;
-    }
-
-let load_embeded_cmi (unit_name, content) =
-  let content = Bytes.of_string content in
-  (* Read cmi magic *)
-  let magic_len = String.length Config.cmi_magic_number in
-  let magic = Bytes.sub content 0 magic_len in
-  assert (magic = Bytes.of_string Config.cmi_magic_number) ;
-  (* Read cmi_name and cmi_sign *)
-  let pos = magic_len in
-  let (cmi_name, cmi_sign) = Marshal.from_bytes content pos in
-  let pos = pos + Marshal.total_size content pos in
-  (* Read cmi_crcs *)
-  let cmi_crcs = Marshal.from_bytes content pos in
-  let pos = pos + Marshal.total_size content pos  in
-  (* Read cmi_flags *)
-  let cmi_flags = Marshal.from_bytes content pos in
-  (* TODO check crcrs... *)
-  Hashtbl.add
-    preloaded_cmis
-    (String.capitalize_ascii unit_name)
-    { filename  =  unit_name ^ ".cmi" ;
-      cmi = { cmi_name; cmi_sign; cmi_crcs; cmi_flags } ;
-    }
-
-let load_embeded_cmis cmis = List.iter load_embeded_cmi cmis
-
-(** Compilation environment.
-
-    [tezos_protocol_env] defines the list of [cmi] available while compiling
-    the protocol version. The [cmi] are packed into the [tezos-node]
-    binary by using [ocp-ocamlres], see the Makefile.
-
-    [register_env] defines a complementary list of [cmi] available
-    while compiling the generated [register.ml] file (that register
-    the protocol first-class module into the [Updater.versions]
-    hashtable).
-
-*)
-
-
-let tezos_protocol_env =
-  let open Embedded_cmis in
-  [
-    "CamlinternalFormatBasics", camlinternalFormatBasics_cmi ;
-    "Tezos_protocol_environment_sigs", tezos_protocol_environment_sigs_cmi ;
-    "Tezos_protocol_environment_sigs__V1", tezos_protocol_environment_sigs__V1_cmi ;
-  ]
-
-let register_env =
-  let open Embedded_cmis in
-  [
-    "tezos_protocol_compiler__Registerer", tezos_protocol_compiler__Registerer_cmi ;
-  ]
-
-
-(** Helpers *)
-
-let (//) = Filename.concat
-
-let create_file ?(perm = 0o644) name content =
-  let open Unix in
-  let fd = openfile name [O_TRUNC; O_CREAT; O_WRONLY] perm in
-  ignore(write_substring fd content 0 (String.length content));
-  close fd
-
-let safe_unlink file =
-  try Unix.unlink file
-  with Unix.Unix_error(Unix.ENOENT, _, _) -> ()
-
-let unlink_cmi dir (file, _) =
-  safe_unlink (dir // file ^ ".cmi")
-
-let unlink_object obj =
-  safe_unlink obj;
-  safe_unlink (Filename.chop_suffix obj ".cmx" ^ ".cmi");
-  safe_unlink (Filename.chop_suffix obj ".cmx" ^ ".o")
-
-let debug_flag = ref false
-
-let debug fmt =
-  if !debug_flag then Format.eprintf fmt
-  else Format.ifprintf Format.err_formatter fmt
-
-let hash_file file =
-  let open Sodium.Generichash in
-  let buflen = 8092 in
-  let buf = BytesLabels.create buflen in
-  let fd = Unix.openfile file [Unix.O_RDONLY] 0o600 in
-  let state = init ~size:32 () in
-  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 ~pos:0 ~len:nb_read
-  in
-  loop () ;
-  Unix.close fd ;
-  BytesLabels.unsafe_to_string (Bytes.of_hash (final state))
-
 (** Semi-generic compilation functions *)
 
 let pack_objects output objects =
@@ -188,97 +63,7 @@ let compile_ml ?for_pack ml =
   Clflags.for_package := None ;
   target ^ ".cmx"
 
-(** Main *)
+let () =
+  Clflags.native_code := true
 
-let mktemp_dir () =
-  Filename.get_temp_dir_name () //
-  Printf.sprintf "tezos-protocol-build-%06X" (Random.int 0xFFFFFF)
-
-let main () =
-  Random.self_init () ;
-  let anonymous = ref []
-  and static = ref false
-  and register = ref false
-  and build_dir = ref None in
-  let args_spec = [
-    "-static", Arg.Set static, " Only build the static library (no .cmxs)";
-    "-register", Arg.Set register, " Generete the `Registerer` module";
-    "-bin-annot", Arg.Set Clflags.binary_annotations, " (see ocamlopt)" ;
-    "-g", Arg.Set Clflags.debug, " (see ocamlopt)" ;
-    "-build-dir", Arg.String (fun s -> build_dir := Some s),
-    "use custom build directory and preserve build artifacts"
-  ] in
-  let usage_msg =
-    Printf.sprintf
-      "Usage: %s [options] <out> <srcdir>\nOptions are:"
-      Sys.argv.(0) in
-  Arg.parse args_spec (fun s -> anonymous := s :: !anonymous) usage_msg ;
-  let (output, source_dir) =
-    match List.rev !anonymous with
-    | [ output ; protocol_dir ] -> output, protocol_dir
-    | _ -> Arg.usage args_spec usage_msg ; Pervasives.exit 1 in
-  let build_dir =
-    match !build_dir with
-    | None ->
-        let dir = mktemp_dir () in
-        at_exit (fun () -> Lwt_main.run (Lwt_utils.remove_dir dir)) ;
-        dir
-    | Some dir -> dir in
-  Lwt_main.run (Lwt_utils.create_dir ~perm:0o755 build_dir) ;
-  Lwt_main.run (Lwt_utils.create_dir ~perm:0o755 (Filename.dirname output)) ;
-  let hash, protocol = Protocol.read_dir source_dir in
-  (* Generate the 'functor' *)
-  let functor_file = build_dir // "functor.ml" in
-  let oc = open_out functor_file in
-  Packer.dump oc
-    (Array.map
-       begin fun { Protocol.name }  ->
-         let name_lowercase = String.uncapitalize_ascii name in
-         source_dir // name_lowercase ^ ".ml"
-       end
-       (Array.of_list protocol.components)) ;
-  close_out oc ;
-  (* Compile the protocol *)
-  let proto_cmi = Filename.chop_extension functor_file ^ ".cmi" in
-  let functor_unit =
-    String.capitalize_ascii
-      Filename.(basename (chop_extension functor_file)) in
-  let for_pack = String.capitalize_ascii (Filename.basename output) in
-  (* Initialize the compilers *)
-  Compenv.(readenv Format.err_formatter Before_args);
-  Clflags.nopervasives := true;
-  Clflags.no_std_include := true ;
-  Clflags.include_dirs := [Filename.dirname functor_file] ;
-  Warnings.parse_options false warnings ;
-  Warnings.parse_options true warn_error ;
-
-  load_embeded_cmis tezos_protocol_env ;
-  let packed_protocol_object = compile_ml ~for_pack functor_file in
-
-  let register_objects =
-    if not !register then
-      []
-    else begin
-      load_embeded_cmis register_env ;
-      load_cmi_from_file proto_cmi ;
-      (* Compiler the 'registering module' *)
-      let register_file = Filename.dirname functor_file // "register.ml" in
-      create_file register_file
-        (Printf.sprintf
-           "module Name = struct let name = %S end\n\
-           \ let () = Tezos_protocol_compiler__Registerer.register Name.name (module %s.Make)"
-           (Protocol_hash.to_b58check hash)
-           functor_unit) ;
-      let register_object = compile_ml ~for_pack register_file in
-      [ register_object ]
-    end
-  in
-
-  let resulting_object =
-    pack_objects output (packed_protocol_object :: register_objects) in
-
-  (* Create the final [cmxs] *)
-  if not !static then begin
-    Clflags.link_everything := true ;
-    link_shared (output ^ ".cmxs") [resulting_object] ;
-  end
+let driver = { compile_ml ; link_shared ; pack_objects }

src/lib_protocol_compiler/native.mli

@@ -7,6 +7,4 @@
 (*                                                                        *)
 (**************************************************************************)
 
-(** Low-level part of the [Updater]. *)
-
-val main: unit -> unit
+val driver: Compiler.driver

src/lib_protocol_updater/jbuild

@@ -5,14 +5,14 @@
   (public_name tezos-protocol-updater)
   (libraries (tezos-base
               tezos-micheline
-              tezos-protocol-compiler
+              tezos-protocol-compiler.registerer
+              tezos-protocol-compiler.native
               tezos-storage
               dynlink))
   (flags (:standard -w -9+27-30-32-40@8
                     -safe-string
                     -open Tezos_base__TzPervasives
                     -open Tezos_micheline
-                    -open Tezos_protocol_compiler
                     -open Tezos_storage))))
 
 (alias

src/lib_protocol_updater/tezos-protocol-updater.opam

@@ -11,7 +11,8 @@ depends: [
   "jbuilder" { build & >= "1.0+beta15" }
   "tezos-base"
   "tezos-micheline"
-  "tezos-protocol-compiler"
+  "tezos-protocol-compiler.registerer"
+  "tezos-protocol-compiler-native"
   "tezos-storage"
 ]
 build: [

src/lib_protocol_updater/updater.ml

@@ -78,11 +78,11 @@ let do_compile hash p =
         Lwt.return false
 
 let compile hash p =
-  if Tezos_protocol_compiler.Registerer.mem hash then
+  if Tezos_protocol_registerer.Registerer.mem hash then
     Lwt.return true
   else begin
     do_compile hash p >>= fun success ->
-    let loaded = Tezos_protocol_compiler.Registerer.mem hash in
+    let loaded = Tezos_protocol_registerer.Registerer.mem hash in
     if success && not loaded then
       log_error "Internal error while compiling %a" Protocol_hash.pp hash;
     Lwt.return loaded

src/lib_shell/state.ml

@@ -706,7 +706,7 @@ module Registred_protocol = struct
   type t = (module T)
 
   let build_v1 hash =
-    let (module F) = Tezos_protocol_compiler.Registerer.get_exn hash in
+    let (module F) = Tezos_protocol_registerer.Registerer.get_exn hash in
     let module Name = struct
       let name = Protocol_hash.to_b58check hash
     end in
@@ -726,7 +726,7 @@ module Registred_protocol = struct
 
   let mem hash =
     VersionTable.mem versions hash ||
-    Tezos_protocol_compiler.Registerer.mem hash
+    Tezos_protocol_registerer.Registerer.mem hash
 
   let get_exn hash =
     try VersionTable.find versions hash