From a5a81f72ecef9e9bf051bd4cebc2811b0767d8e9 Mon Sep 17 00:00:00 2001 From: James Hinshelwood Date: Tue, 16 Apr 2024 09:51:31 +0100 Subject: [PATCH] Send contracts and messages via HTTP rather than the file system (#1252) Previously, requests would contain a path to a file for: * Scilla contracts * Init data JSON * Message JSON Instead, we send these directly in the message. The maximum size of a Scilla contract is ~75KB and the maximum size of init data and messages is ~135KB. I've also deleted two utilities that we aren't (yet) using in ZQ2, so that I don't have to spend time supporting the new request format for them. --- src/base/Checker.ml | 27 ++++---- src/base/DebugMessage.ml | 8 +-- src/base/FrontEndParser.ml | 5 ++ src/base/JSON.ml | 80 ++++++++++++++++++++++++ src/base/RunnerUtil.ml | 42 ++++++++++--- src/eval/Runner.ml | 34 +++++------ src/eval/RunnerCLI.ml | 36 +++-------- src/eval/RunnerCLI.mli | 2 +- src/runners/dune | 6 +- src/runners/eval_runner.ml | 112 ---------------------------------- src/runners/scilla_runner.ml | 5 +- src/runners/type_checker.ml | 115 ----------------------------------- 12 files changed, 160 insertions(+), 312 deletions(-) delete mode 100644 src/runners/eval_runner.ml delete mode 100644 src/runners/type_checker.ml diff --git a/src/base/Checker.ml b/src/base/Checker.ml index 02e7b21fa..a75b33954 100644 --- a/src/base/Checker.ml +++ b/src/base/Checker.ml @@ -63,7 +63,7 @@ module CG = ScillaCallgraph (TCSRep) (TCERep) (* Check that the module parses *) let check_parsing ctr syn = - let ast = FEParser.parse_file syn ctr in + let ast = FEParser.parse_string syn ctr in if Result.is_ok ast then plog @@ sprintf "\n[Parsing]:\n module [%s] is successfully parsed.\n" ctr; ast @@ -236,15 +236,14 @@ let check_lmodule cli = let initial_gas = Uint64.mul Gas.scale_factor cli.gas_limit in let%bind (lmod : ParserSyntax.lmodule) = wrap_error_with_gas initial_gas - @@ check_parsing cli.input_file Parser.Incremental.lmodule + @@ check_parsing cli.input Parser.Incremental.lmodule in let this_address_opt, init_address_map = - Option.value_map cli.init_file ~f:get_init_this_address_and_extlibs + Option.value_map cli.init ~f:get_init_this_address_and_extlibs_string ~default:(None, []) in - let this_address = - Option.value this_address_opt - ~default:(FilePath.chop_extension (FilePath.basename cli.input_file)) + (* this_address is mandatory *) + let this_address = Option.value_exn this_address_opt in let elibs = import_libs lmod.elibs init_address_map in let%bind dis_lmod = @@ -307,17 +306,16 @@ let check_cmodule cli = let initial_gas = Uint64.mul Gas.scale_factor cli.gas_limit in let%bind (cmod : ParserSyntax.cmodule) = wrap_error_with_gas initial_gas - @@ check_parsing cli.input_file Parser.Incremental.cmodule + @@ check_parsing cli.input Parser.Incremental.cmodule in let cmod = FEParser.disambiguate_calls cmod in (* Import whatever libs we want. *) let this_address_opt, init_address_map = - Option.value_map cli.init_file ~f:get_init_this_address_and_extlibs + Option.value_map cli.init ~f:get_init_this_address_and_extlibs_string ~default:(None, []) in - let this_address = - Option.value this_address_opt - ~default:(FilePath.chop_extension (FilePath.basename cli.input_file)) + (* this_address is mandatory *) + let this_address = Option.value_exn this_address_opt in let elibs = import_libs cmod.elibs init_address_map in let%bind dis_cmod = @@ -344,7 +342,7 @@ let check_cmodule cli = CG.dump_callgraph stdout cg; exit 0) else if cli.dump_callgraph then - let out = Out_channel.create (cli.input_file ^ ".dot") ~binary:true in + let out = Out_channel.create ("callgraph.dot") ~binary:true in CG.dump_callgraph out cg); let%bind () = if cli.disable_analy_warn then pure () @@ -441,10 +439,9 @@ let run args ~exe_name = let cli = init_checker args ~exe_name in let open FilePath in let open GlobalConfig.StdlibTracker in - if check_extension cli.input_file file_extn_library then + if cli.is_library then (* Check library modules. *) check_lmodule cli |> fun (out, _) -> out - else if check_extension cli.input_file file_extn_contract then + else (* Check contract modules. *) check_cmodule cli |> fun (out, _) -> out - else fatal_error (mk_error0 ~kind:"Unknown file extension" ?inst:None) diff --git a/src/base/DebugMessage.ml b/src/base/DebugMessage.ml index 93b7e4e29..6554af041 100644 --- a/src/base/DebugMessage.ml +++ b/src/base/DebugMessage.ml @@ -23,18 +23,14 @@ open GlobalConfig let plog msg = match get_debug_level () with | Debug_Normal | Debug_Verbose -> - let fname = get_log_file () in - Out_channel.with_file fname ~append:true ~f:(fun h -> - Out_channel.output_string h msg) + print_endline msg; | Debug_None -> () (* Verbose print to log file *) let pvlog msg = match get_debug_level () with | Debug_Verbose -> - let fname = get_log_file () in - Out_channel.with_file fname ~append:true ~f:(fun h -> - Out_channel.output_string h (msg ())) + print_endline (msg ()); | Debug_Normal | Debug_None -> () (* Prints to stdout and log file *) diff --git a/src/base/FrontEndParser.ml b/src/base/FrontEndParser.ml index d9dbc149a..d37607ade 100644 --- a/src/base/FrontEndParser.ml +++ b/src/base/FrontEndParser.ml @@ -137,11 +137,16 @@ module ScillaFrontEndParser (Literal : ScillaLiteral) = struct let parse_expr_from_stdin () = parse_stdin Parser.Incremental.exp_term let parse_lmodule filename = parse_file Parser.Incremental.lmodule filename + let parse_lmodule_string s = parse_string Parser.Incremental.lmodule s let parse_cmodule filename = let open Result.Let_syntax in let%bind cmod = parse_file Parser.Incremental.cmodule filename in pure @@ disambiguate_calls cmod + let parse_cmodule_string s = + let open Result.Let_syntax in + let%bind cmod = parse_string Parser.Incremental.cmodule s in + pure @@ disambiguate_calls cmod let get_comments () = Lexer.get_comments () end diff --git a/src/base/JSON.ml b/src/base/JSON.ml index 6de10a65b..c84502b20 100644 --- a/src/base/JSON.ml +++ b/src/base/JSON.ml @@ -60,6 +60,10 @@ let from_file f = let thunk () = Basic.from_file f in json_exn_wrapper thunk ~filename:f +let from_string f = + let thunk () = Basic.from_string f in + json_exn_wrapper thunk ~filename:f + let parse_as_name n = match String.split_on_chars ~on:[ '.' ] n with | [ t1; t2 ] -> JSONName.parse_qualified_name t1 t2 @@ -329,6 +333,18 @@ module ContractState = struct in (curstates, List.concat extstates) + let get_json_data_string s = + let json = from_string s in + (* input json is a list of key/value pairs *) + let jlist = json |> to_list_exn in + let curstates, extstates = + List.partition_map jlist ~f:(fun j -> + match jobj_to_statevar j with + | ThisContr (n, t, v) -> First (n, t, v) + | ExtrContrs extlist -> Second extlist) + in + (curstates, List.concat extstates) + (* Get a json object from given states *) let state_to_json states = let states_str = @@ -414,6 +430,35 @@ module ContractState = struct ~kind:"Illegal type for field specified in init json" ~inst:(JSONName.as_string ContractUtil.this_address_label))) + let get_init_this_address_and_extlibs_string s = + (* We filter out type information from init files for the time being *) + let init_data, _ = get_json_data_string s in + let extlibs = get_init_extlibs init_data in + let this_address_init_opt = + match + List.filter init_data ~f:(fun (name, _, _) -> + String.(name = JSONName.as_string ContractUtil.this_address_label)) + with + | [ (_, _, adr) ] -> Some adr + | [] -> + None + (* We allow init files without a _this_address entry in scilla-checker *) + | _ -> + raise + (mk_invalid_json ~kind:"Multiple entries specified in init json" + ~inst:(JSONName.as_string ContractUtil.this_address_label)) + in + match this_address_init_opt with + | None -> (None, extlibs) + | Some adr -> ( + match get_address_literal adr with + | Some adr -> (Some adr, extlibs) + | None -> + raise + (mk_invalid_json + ~kind:"Illegal type for field specified in init json" + ~inst:(JSONName.as_string ContractUtil.this_address_label))) + (* Convert a single JSON serialized literal back to its Scilla value. *) let jstring_to_literal jstring tp = let thunk () = Yojson.Basic.from_string jstring in @@ -460,6 +505,41 @@ module Message = struct in tag :: amount :: origin :: sender :: params + let get_json_data_string s = + let json = from_string s in + let tags = member_exn tag_label json |> to_string_exn in + let amounts = member_exn amount_label json |> to_string_exn in + let senders = member_exn sender_label json |> to_string_exn in + let origins = member_exn origin_label json |> to_string_exn in + (* Make tag, amount and sender into a literal *) + let tag = + (tag_label, tag_type, build_prim_lit_exn JSONType.string_typ tags) + in + let amount = + (amount_label, amount_type, build_prim_lit_exn amount_type amounts) + in + let sender = + (sender_label, sender_type, build_prim_lit_exn sender_type senders) + in + let origin = + (origin_label, origin_type, build_prim_lit_exn origin_type origins) + in + let pjlist = member_exn "params" json |> to_list_exn in + let params = + List.map pjlist ~f:(fun f -> + let name, t, v = + match jobj_to_statevar f with + | ThisContr (name, t, v) -> (name, t, v) + | ExtrContrs _ -> + raise + (mk_invalid_json + ~kind:"_external cannot be present in a message JSON" + ?inst:None) + in + (name, t, v)) + in + tag :: amount :: origin :: sender :: params + (* Same as message_to_jstring, but instead gives out raw json, not it's string *) let message_to_json message = (* extract out "_tag", "_amount", "_accepted" and "_recipient" parts of the message *) diff --git a/src/base/RunnerUtil.ml b/src/base/RunnerUtil.ml index f96cd0057..9d563c131 100644 --- a/src/base/RunnerUtil.ml +++ b/src/base/RunnerUtil.ml @@ -65,6 +65,24 @@ let get_init_this_address_and_extlibs filename = fatal_error (s @ mk_error0 ~kind:"Unable to parse JSON file" ~inst:filename) +let get_init_this_address_and_extlibs_string str = + try + let this_address, name_addr_pairs = + JSON.ContractState.get_init_this_address_and_extlibs_string str + in + if + List.contains_dup + ~compare:(fun a b -> String.compare (fst a) (fst b)) + name_addr_pairs + then + fatal_error + @@ mk_error0 ~kind:"Duplicate extlib map entries in init JSON file" + ~inst:str + else (this_address, name_addr_pairs) + with Invalid_json s -> + fatal_error + (s @ mk_error0 ~kind:"Unable to parse JSON file" ~inst:str) + (* Find (by looking for in StdlibTracker) and parse library named "id.scillib". * If "id.json" exists, parse it's extlibs info and provide that also. *) let import_lib name sloc = @@ -191,12 +209,13 @@ let import_all_libs ldirs = import_libs names' [] type runner_cli = { - input_file : string; + input : string; + is_library : bool; stdlib_dirs : string list; gas_limit : Stdint.uint64; (* Run gas use analysis? *) gua_flag : bool; - init_file : string option; + init : string option; cf_flag : bool; cf_token_fields : string list; p_contract_info : bool; @@ -209,8 +228,9 @@ type runner_cli = { let parse_cli args ~exe_name = let r_stdlib_dir = ref [] in let r_gas_limit = ref None in - let r_input_file = ref "" in - let r_init_file = ref None in + let r_input = ref "" in + let r_is_library = ref false in + let r_init = ref None in let r_json_errors = ref false in let r_gua = ref false in let r_contract_info = ref false in @@ -247,8 +267,9 @@ let parse_cli args ~exe_name = Arg.Unit (fun () -> r_gua := true), "Run gas use analysis and print use polynomial." ); ( "-init", - Arg.String (fun x -> r_init_file := Some x), - "Path to initialization json" ); + Arg.String (fun x -> r_init := Some x), + "Initialization json" ); + ( "-islibrary", Arg.Unit (fun () -> r_is_library := true), "Is the contract a library?"); ( "-cf", Arg.Unit (fun () -> r_cf := true), "Run cashflow checker and print results" ); @@ -298,7 +319,7 @@ let parse_cli args ~exe_name = let usage = mandatory_usage ^ "\n " ^ optional_usage ^ "\n" in (* Only one input file allowed, so the last anonymous argument will be *it*. *) - let anon_handler s = r_input_file := s in + let anon_handler s = r_input := s in let () = match args with | None -> Arg.parse speclist anon_handler mandatory_usage @@ -310,21 +331,22 @@ let parse_cli args ~exe_name = with Arg.Bad msg | Arg.Help msg -> fatal_error_noformat (Printf.sprintf "%s\n" msg)) in - if String.is_empty !r_input_file then fatal_error_noformat usage; + if String.is_empty !r_input then fatal_error_noformat usage; let gas_limit = match !r_gas_limit with Some g -> g | None -> fatal_error_noformat usage in if not @@ List.is_empty !r_cf_token_fields then r_cf := true; GlobalConfig.set_use_json_errors !r_json_errors; { - input_file = !r_input_file; + input = !r_input; + is_library = !r_is_library; stdlib_dirs = !r_stdlib_dir; gas_limit; gua_flag = !r_gua; p_contract_info = !r_contract_info; cf_flag = !r_cf; cf_token_fields = !r_cf_token_fields; - init_file = !r_init_file; + init = !r_init; p_type_info = !r_type_info; disable_analy_warn = !r_disable_analy_warn; dump_callgraph = !r_dump_callgraph; diff --git a/src/eval/Runner.ml b/src/eval/Runner.ml index f7c22ed2f..da50d1348 100644 --- a/src/eval/Runner.ml +++ b/src/eval/Runner.ml @@ -115,9 +115,9 @@ let map_json_input_strings_to_names map = | _ -> raise (mk_invalid_json ~kind:"invalid name in json input" ~inst:x)) (* Parse the input state json and extract out _balance separately *) -let input_state_json filename = +let input_state_json s = let open JSON.ContractState in - let states_str, estates_str = get_json_data filename in + let states_str, estates_str = get_json_data_string s in let states = map_json_input_strings_to_names states_str in let estates = List.map estates_str ~f:(fun (addr, states_str) -> @@ -225,13 +225,13 @@ let assert_no_address_type_in_literal l gas_remaining = in recurser l -let validate_get_init_json init_file gas_remaining source_ver = +let validate_get_init_json str gas_remaining source_ver = (* Retrieve initial parameters *) let initargs_str, _ = - try JSON.ContractState.get_json_data init_file + try JSON.ContractState.get_json_data_string str with Invalid_json s -> fatal_error_gas_scale Gas.scale_factor - (s @ mk_error0 ~kind:"Failed to parse json" ~inst:init_file) + (s @ mk_error0 ~kind:"Failed to parse json" ~inst:str) gas_remaining in (* Read init.json, and strip types. Types in init files must be ignored due to backward compatibility *) @@ -308,7 +308,7 @@ let perform_dynamic_typechecks checks gas_remaining = | Error s -> fatal_error_gas_scale Gas.scale_factor s new_gas_remaining) let deploy_library args gas_remaining = - match FEParser.parse_lmodule args.input with + match FEParser.parse_lmodule_string args.input with | Error e -> (* Error is printed by the parser. *) plog (sprintf "%s\n" "Failed to parse input library file."); @@ -319,10 +319,10 @@ let deploy_library args gas_remaining = args.input); (* Parse external libraries. *) - let lib_dirs = FilePath.dirname args.input :: args.libdirs in + let lib_dirs = args.libdirs in StdlibTracker.add_stdlib_dirs lib_dirs; let this_address_opt, init_address_map = - get_init_this_address_and_extlibs args.input_init + get_init_this_address_and_extlibs_string args.input_init in match this_address_opt with | None -> @@ -380,16 +380,12 @@ let deploy_library args gas_remaining = let run_with_args args = let is_deployment = String.is_empty args.input_message in let is_ipc = not @@ String.is_empty args.ipc_address in - let is_library = - FilePath.check_extension args.input - GlobalConfig.StdlibTracker.file_extn_library - in + let is_library = args.is_library in let initial_gas_limit = Uint64.mul args.gas_limit Gas.scale_factor in let gas_remaining = (* Subtract gas based on (contract+init) size / message size. *) if is_deployment then - let cost' = - UnixLabels.((stat args.input).st_size + (stat args.input_init).st_size) + let cost' = (String.length args.input) + (String.length args.input_init) in let cost = Uint64.of_int cost' in if Uint64.compare initial_gas_limit cost < 0 then @@ -399,7 +395,7 @@ let run_with_args args = Uint64.zero else Uint64.sub initial_gas_limit cost else - let cost = Uint64.of_int (UnixLabels.stat args.input_message).st_size in + let cost = Uint64.of_int (String.length args.input_message) in if Uint64.compare initial_gas_limit cost < 0 then fatal_error_gas_scale Gas.scale_factor (mk_error0 ~kind:"Insufficient gas to parse message" ?inst:None) @@ -420,7 +416,7 @@ let run_with_args args = ("events", output_event_json []); ] else - match FEParser.parse_cmodule args.input with + match FEParser.parse_cmodule_string args.input with | Error e -> (* Error is printed by the parser. *) plog (sprintf "%s\n" "Failed to parse input file."); @@ -432,10 +428,10 @@ let run_with_args args = args.input); (* Parse external libraries. *) - let lib_dirs = FilePath.dirname args.input :: args.libdirs in + let lib_dirs = args.libdirs in StdlibTracker.add_stdlib_dirs lib_dirs; let this_address_opt, init_address_map = - get_init_this_address_and_extlibs args.input_init + get_init_this_address_and_extlibs_string args.input_init in match this_address_opt with | None -> @@ -576,7 +572,7 @@ let run_with_args args = else (* Not initialization, execute transition specified in the message *) let mmsg = - try JSON.Message.get_json_data args.input_message + try JSON.Message.get_json_data_string args.input_message with Invalid_json s -> fatal_error_gas_scale Gas.scale_factor (s diff --git a/src/eval/RunnerCLI.ml b/src/eval/RunnerCLI.ml index cde2af997..dd0e781d6 100644 --- a/src/eval/RunnerCLI.ml +++ b/src/eval/RunnerCLI.ml @@ -24,8 +24,8 @@ type args = { input_state : string; input_message : string; input_blockchain : string; - output : string; input : string; + is_library : bool; libdirs : string list; gas_limit : Stdint.uint64; balance : Stdint.uint128; @@ -38,8 +38,8 @@ let f_input_init = ref "" let f_input_state = ref "" let f_input_message = ref "" let f_input_blockchain = ref "" -let f_output = ref "" let f_input = ref "" +let f_is_library = ref false let f_trace_file = ref "" let f_trace_level = ref "" let d_libs = ref [] @@ -56,8 +56,8 @@ let reset () = f_input_state := ""; f_input_message := ""; f_input_blockchain := ""; - f_output := ""; f_input := ""; + f_is_library := false; f_trace_file := ""; f_trace_level := ""; d_libs := []; @@ -88,36 +88,18 @@ let validate_main usage = not (String.is_empty fname || Sys_unix.file_exists_exn fname) in let msg = "" in - let msg = - (* init.json is mandatory *) - if not @@ Sys_unix.file_exists_exn !f_input_init then - "Invalid initialization file\n" - else msg - in let msg = (* input_state.json is not mandatory, but if provided, should be valid *) if invalid_optional_fname !f_input_state then msg ^ "Invalid input contract state: " ^ !f_input_state ^ "\n" else msg in - let msg = - (* input_message.json is not mandatory, but if provided, should be valid *) - if invalid_optional_fname !f_input_message then - msg ^ "Invalid input message\n" - else msg - in let msg = (* input_blockchain.json is not mandatory, but if provided, should be valid *) if invalid_optional_fname !f_input_blockchain then msg ^ "Invalid input blockchain state\n" else msg in - let msg = - (* input file is mandatory *) - if not @@ Sys_unix.file_exists_exn !f_input then - msg ^ "Invalid input contract file\n" - else msg - in (* Note: output file is optional, if it's missing we will output to stdout *) let msg = (* input_message.json and input_state.json / i_ipc_address+balance can either both be there or both absent *) @@ -167,13 +149,13 @@ let parse args ~exe_name = "Print Scilla version and exit" ); ( "-init", Arg.String (fun x -> f_input_init := x), - "Path to initialization json" ); + "Initialization json" ); ( "-istate", Arg.String (fun x -> f_input_state := x), - "Path to state input json" ); + "State input json" ); ( "-imessage", Arg.String (fun x -> f_input_message := x), - "Path to message input json" ); + "Message input json" ); ( "-ipcaddress", Arg.String (fun x -> i_ipc_address := x), "Socket address for IPC communication with blockchain for state access" @@ -181,8 +163,8 @@ let parse args ~exe_name = ( "-iblockchain", Arg.String (fun x -> f_input_blockchain := x), "Path to blockchain input json" ); - ("-o", Arg.String (fun x -> f_output := x), "Path to output json"); - ("-i", Arg.String (fun x -> f_input := x), "Path to scilla contract"); + ("-i", Arg.String (fun x -> f_input := x), "Scilla contract"); + ("-islibrary", Arg.Bool (fun b -> f_is_library := b), "Is the contract a library?"); ( "-tracefile", Arg.String (fun x -> f_trace_file := x), "Path to trace file. (prints to stdout if no file specified)" ); @@ -275,8 +257,8 @@ let parse args ~exe_name = input_state = !f_input_state; input_message = !f_input_message; input_blockchain = !f_input_blockchain; - output = !f_output; input = !f_input; + is_library = !f_is_library; balance = (match !v_balance with Some v -> v | None -> Stdint.Uint128.zero); libdirs = !d_libs; diff --git a/src/eval/RunnerCLI.mli b/src/eval/RunnerCLI.mli index f85aa43fe..48e8c9e56 100644 --- a/src/eval/RunnerCLI.mli +++ b/src/eval/RunnerCLI.mli @@ -21,8 +21,8 @@ type args = { input_state : string; input_message : string; input_blockchain : string; - output : string; input : string; + is_library : bool; libdirs : string list; gas_limit : Stdint.uint64; balance : Stdint.uint128; diff --git a/src/runners/dune b/src/runners/dune index e78418762..c213077c3 100644 --- a/src/runners/dune +++ b/src/runners/dune @@ -1,10 +1,10 @@ (executables - (names scilla_runner eval_runner type_checker scilla_checker scilla_server + (names scilla_runner scilla_checker scilla_server disambiguate_state_json scilla_fmt scilla_merger scilla_server_http) - (public_names scilla-runner eval-runner type-checker scilla-checker + (public_names scilla-runner scilla-checker scilla-server disambiguate_state_json scilla-fmt scilla-merger scilla-server-http) (package scilla) - (modules scilla_runner eval_runner type_checker scilla_checker scilla_server + (modules scilla_runner scilla_checker scilla_server disambiguate_state_json scilla_fmt scilla_merger scilla_server_http) (libraries core core_unix.command_unix angstrom yojson cryptokit fileutils scilla_base scilla_eval scilla_server_lib scilla_crypto scilla_format diff --git a/src/runners/eval_runner.ml b/src/runners/eval_runner.ml deleted file mode 100644 index 79130b90f..000000000 --- a/src/runners/eval_runner.ml +++ /dev/null @@ -1,112 +0,0 @@ -(* - This file is part of scilla. - - Copyright (c) 2018 - present Zilliqa Research Pvt. Ltd. - - scilla is free software: you can redistribute it and/or modify it under the - terms of the GNU General Public License as published by the Free Software - Foundation, either version 3 of the License, or (at your option) any later - version. - - scilla is distributed in the hope that it will be useful, but WITHOUT ANY - WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR - A PARTICULAR PURPOSE. See the GNU General Public License for more details. - - You should have received a copy of the GNU General Public License along with - scilla. If not, see . -*) - -open Core -open Scilla_base -open Scilla_eval -open Literal -open RunnerUtil -open ErrorUtils -open GlobalConfig -open PrettyPrinters -open Result.Let_syntax -open ParserUtil -open MonadUtil -module RG = Gas.ScillaGas (ParserRep) (ParserRep) - -(* Stdlib are implicitly imported, so we need to use local names in the parser *) -module FEParser = FrontEndParser.ScillaFrontEndParser (LocalLiteral) -module Dis = Disambiguate.ScillaDisambiguation (ParserRep) (ParserRep) -module GlobalSyntax = Dis.PostDisSyntax - -let default_gas_limit = Stdint.Uint64.of_int 2000 - -let gas_cost_rewriter_wrapper gas_remaining rewriter anode = - match rewriter anode with - | Error e -> fatal_error_gas_scale Gas.scale_factor e gas_remaining - | Ok anode' -> anode' - -let disambiguate e (std_lib : GlobalSyntax.libtree list) = - let open Dis in - let open GlobalSyntax in - let%bind imp_var_dict, imp_typ_dict, imp_ctr_dict = - foldM std_lib ~init:([], [], []) ~f:(fun acc_dicts lt -> - let ({ libn; _ } : libtree) = lt in - let lib_address = SIdentifier.as_string libn.lname in - amend_imported_ns_dict libn lib_address None acc_dicts - (SIdentifier.get_rep libn.lname)) - in - let imp_dicts = - { - var_dict = imp_var_dict; - typ_dict = imp_typ_dict; - ctr_dict = imp_ctr_dict; - } - in - match disambiguate_exp imp_dicts e with - | Error _ -> fail0 ~kind:"Failed to disambiguate" ?inst:None - | Ok e -> pure e - -let run () = - GlobalConfig.reset (); - ErrorUtils.reset_warnings (); - Datatypes.DataTypeDictionary.reinit (); - let cli = parse_cli None ~exe_name:Sys.(get_argv ()).(0) in - let filename = cli.input_file in - let gas_limit' = - if Stdint.Uint64.(compare cli.gas_limit zero = 0) then default_gas_limit - else cli.gas_limit - in - let gas_limit = Stdint.Uint64.mul gas_limit' Gas.scale_factor in - match FEParser.parse_expr_from_file filename with - | Ok e_nogas -> ( - StdlibTracker.add_stdlib_dirs cli.stdlib_dirs; - let lib_dirs = StdlibTracker.get_stdlib_dirs () in - if List.is_empty lib_dirs then stdlib_not_found_err (); - (* Import all libraries in known stdlib paths. *) - let elibs = - List.map ~f:(gas_cost_rewriter_wrapper gas_limit RG.libtree_cost) - @@ import_all_libs lib_dirs - in - match disambiguate e_nogas elibs with - | Ok dis_e_nogas -> ( - let dis_e = - gas_cost_rewriter_wrapper gas_limit RG.expr_static_cost dis_e_nogas - in - (* Since this is not a contract, we have no in-contract lib defined. *) - let envres = Eval.init_libraries None elibs in - let env, gas_remaining = - match envres Eval.init_gas_kont gas_limit with - | Ok (env', gas_remaining) -> (env', gas_remaining) - | Error (err, gas_remaining) -> - fatal_error_gas_scale Gas.scale_factor err gas_remaining - in - let lib_fnames = List.map ~f:(fun (name, _) -> name) env in - let res' = Eval.(exp_eval dis_e env init_gas_kont gas_remaining) in - match res' with - | Ok (_, gas_remaining) -> - let gas_remaining' = - Gas.finalize_remaining_gas cli.gas_limit gas_remaining - in - printf "%s\n" (Eval.pp_result res' lib_fnames gas_remaining') - | Error (el, gas_remaining) -> - fatal_error_gas_scale Gas.scale_factor el gas_remaining) - | Error e -> fatal_error e) - | Error e -> fatal_error e - -let () = try run () with FatalError msg -> exit_with_error msg diff --git a/src/runners/scilla_runner.ml b/src/runners/scilla_runner.ml index 05423cead..c9b681394 100644 --- a/src/runners/scilla_runner.ml +++ b/src/runners/scilla_runner.ml @@ -30,8 +30,5 @@ let () = try let output, args = Runner.run None ~exe_name:(Sys.get_argv ()).(0) in let str = output_to_string output ~args in - if String.is_empty args.output then DebugMessage.pout str - else - Out_channel.with_file args.output ~f:(fun ch -> - Out_channel.output_string ch str) + DebugMessage.pout str with FatalError msg -> exit_with_error msg diff --git a/src/runners/type_checker.ml b/src/runners/type_checker.ml deleted file mode 100644 index 1a85a3541..000000000 --- a/src/runners/type_checker.ml +++ /dev/null @@ -1,115 +0,0 @@ -(* - This file is part of scilla. - - Copyright (c) 2018 - present Zilliqa Research Pvt. Ltd. - - scilla is free software: you can redistribute it and/or modify it under the - terms of the GNU General Public License as published by the Free Software - Foundation, either version 3 of the License, or (at your option) any later - version. - - scilla is distributed in the hope that it will be useful, but WITHOUT ANY - WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR - A PARTICULAR PURPOSE. See the GNU General Public License for more details. - - You should have received a copy of the GNU General Public License along with - scilla. If not, see . -*) - -open Core -open Printf -open Scilla_base -open Literal -open ParserUtil -open TypeUtil -open RunnerUtil -open DebugMessage -open MonadUtil -open PatternChecker -open PrettyPrinters -open GasUseAnalysis -open TypeInfo -open ErrorUtils -module PSRep = ParserRep -module PERep = ParserRep - -(* Stdlib are implicitly imported, so we need to use local names in the parser *) -module FEParser = FrontEndParser.ScillaFrontEndParser (LocalLiteral) -module Parser = FEParser.Parser -module Syn = FEParser.FESyntax -module Dis = Disambiguate.ScillaDisambiguation (PSRep) (PERep) -module GlobalSyntax = Dis.PostDisSyntax -module RC = Recursion.ScillaRecursion (PSRep) (PERep) -module RCSRep = RC.OutputSRep -module RCERep = RC.OutputERep -module TC = TypeChecker.ScillaTypechecker (RCSRep) (RCERep) -module TCSRep = TC.OutputSRep -module TCERep = TC.OutputERep -module PM_Checker = ScillaPatternchecker (TCSRep) (TCERep) -module TI = ScillaTypeInfo (TCSRep) (TCERep) -module GUA_Checker = ScillaGUA (TCSRep) (TCERep) -open TypeCheckerUtil - -(* Check that the expression parses *) -let check_parsing filename = - match FEParser.parse_file Parser.Incremental.exp_term filename with - | Error _ -> fail0 ~kind:"Failed to parse input file" ~inst:filename - | Ok e -> - plog - @@ sprintf "\n[Parsing]:\nExpression in [%s] is successfully parsed.\n" - filename; - pure e - -(* Check that the expression parses *) -let run () = - GlobalConfig.reset (); - ErrorUtils.reset_warnings (); - Datatypes.DataTypeDictionary.reinit (); - let cli = parse_cli None ~exe_name:Sys.(get_argv ()).(0) in - let open GlobalConfig in - StdlibTracker.add_stdlib_dirs cli.stdlib_dirs; - let filename = cli.input_file in - let gas_limit = cli.gas_limit in - match FEParser.parse_file Parser.Incremental.exp_term filename with - | Ok e -> ( - (* Get list of stdlib dirs. *) - let lib_dirs = StdlibTracker.get_stdlib_dirs () in - if List.is_empty lib_dirs then stdlib_not_found_err (); - (* Import all libs. *) - let std_lib = import_all_libs lib_dirs in - match disambiguate e std_lib with - | Ok dis_e -> ( - let rlibs, elibs, e = - match check_recursion dis_e std_lib with - | Ok (rlibs, elibs, e) -> (rlibs, elibs, e) - | Error s -> fatal_error s - in - match check_typing e elibs rlibs gas_limit with - | Ok - ( (typed_rlibs, typed_elibs, ((_, (e_typ, _)) as typed_erep)), - _remaining_gas ) -> ( - match check_patterns typed_rlibs typed_elibs typed_erep with - | Ok _ -> ( - let tj = - [ ("type", `String (GlobalSyntax.SType.pp_typ e_typ.tp)) ] - in - let output_j = - `Assoc - (if cli.p_type_info then - ( "type_info", - JSON.TypeInfo.type_info_to_json - (TI.type_info_expr typed_erep) ) - :: tj - else tj) - in - pout (sprintf "%s\n" (Yojson.Basic.pretty_to_string output_j)); - if cli.gua_flag then - match analyze_gas typed_erep with - | Ok _ -> () - | Error el -> fatal_error el) - | Error el -> fatal_error el) - | Error ((_, el), _remaining_gas) -> fatal_error el) - | Error e -> fatal_error e) - | Error e -> fatal_error e - -let () = try run () with FatalError msg -> exit_with_error msg