Compiler: preserve Protocol_hash

This commit is contained in:
Grégoire Henry 2018-04-16 00:44:21 +02:00
parent aeacd845f2
commit 7adc0c90e7
5 changed files with 7 additions and 14 deletions

View File

@ -171,7 +171,7 @@ let main { compile_ml ; pack_objects ; link_shared } =
(* Generate the 'functor' *) (* Generate the 'functor' *)
let functor_file = build_dir // "functor.ml" in let functor_file = build_dir // "functor.ml" in
let oc = open_out functor_file in let oc = open_out functor_file in
Packer.dump oc Packer.dump oc hash
(Array.map (Array.map
begin fun { Protocol.name } -> begin fun { Protocol.name } ->
let name_lowercase = String.uncapitalize_ascii name in let name_lowercase = String.uncapitalize_ascii name in

View File

@ -20,14 +20,14 @@ let () =
match List.rev !anonymous with match List.rev !anonymous with
| [ source_dir ] -> source_dir | [ source_dir ] -> source_dir
| _ -> Arg.usage args_spec usage_msg ; Pervasives.exit 1 in | _ -> Arg.usage args_spec usage_msg ; Pervasives.exit 1 in
let _hash, protocol = let hash, protocol =
match Lwt_main.run (Lwt_utils_unix.Protocol.read_dir source_dir) with match Lwt_main.run (Lwt_utils_unix.Protocol.read_dir source_dir) with
| Ok v -> v | Ok v -> v
| Error err -> | Error err ->
Format.kasprintf Pervasives.failwith Format.kasprintf Pervasives.failwith
"Failed to read TEZOS_PROTOCOL: %a" pp_print_error err in "Failed to read TEZOS_PROTOCOL: %a" pp_print_error err in
(* Generate the 'functor' *) (* Generate the 'functor' *)
Packer.dump stdout Packer.dump stdout hash
(Array.map (Array.map
begin fun { Protocol.name ; _ } -> begin fun { Protocol.name ; _ } ->
let name_lowercase = String.uncapitalize_ascii name in let name_lowercase = String.uncapitalize_ascii name in

View File

@ -46,12 +46,14 @@ let opened_modules = [
"Logging" ; "Logging" ;
] ]
let dump oc files = let dump oc hash files =
Printf.fprintf oc Printf.fprintf oc
"module Make (Tezos_protocol_environment : Tezos_protocol_environment_sigs__V1.T) = struct\n" ; "module Make (Tezos_protocol_environment : Tezos_protocol_environment_sigs__V1.T) = struct\n" ;
Printf.fprintf oc "[@@@ocaml.warning \"-33\"]\n" ; Printf.fprintf oc "[@@@ocaml.warning \"-33\"]\n" ;
List.iter (Printf.fprintf oc "open %s\n") opened_modules ; List.iter (Printf.fprintf oc "open %s\n") opened_modules ;
Printf.fprintf oc "[@@@ocaml.warning \"+33\"]\n" ; Printf.fprintf oc "[@@@ocaml.warning \"+33\"]\n" ;
Printf.fprintf oc "let hash = Protocol_hash.of_b58check_exn %S;;\n"
(Protocol_hash.to_b58check hash) ;
for i = 0 to Array.length files - 1 do for i = 0 to Array.length files - 1 do
include_ml oc files.(i) ; include_ml oc files.(i) ;
done ; done ;
@ -60,6 +62,3 @@ let dump oc files =
(Filename.basename (Filename.basename
(Filename.chop_extension files.(Array.length files - 1)))) ; (Filename.chop_extension files.(Array.length files - 1)))) ;
Printf.fprintf oc "end\n%!" Printf.fprintf oc "end\n%!"
let main () =
dump stdout (Array.sub Sys.argv 1 (Array.length Sys.argv - 2))

View File

@ -7,6 +7,4 @@
(* *) (* *)
(**************************************************************************) (**************************************************************************)
val dump: out_channel -> string array -> unit val dump: out_channel -> Protocol_hash.t -> string array -> unit
val main: unit -> unit

View File

@ -11,10 +11,6 @@ module Name = struct let name = "alpha" end
module Alpha_environment = Tezos_protocol_environment_faked.MakeV1(Name)() module Alpha_environment = Tezos_protocol_environment_faked.MakeV1(Name)()
include Tezos_protocol_alpha.Functor.Make(Alpha_environment) include Tezos_protocol_alpha.Functor.Make(Alpha_environment)
let hash =
Protocol_hash.of_b58check_exn
"ProtoALphaALphaALphaALphaALphaALphaALphaALphaDdp3zK"
class type rpc_context = object class type rpc_context = object
inherit RPC_context.json inherit RPC_context.json
inherit [Block_services.block] Alpha_environment.RPC_context.simple inherit [Block_services.block] Alpha_environment.RPC_context.simple