Revision 0c15b98d5e5f1d59c33b9e08a1e9a03b60b6642d authored by lin on 14 June 2023, 10:14:22 UTC, committed by Marge Bot on 15 June 2023, 01:59:12 UTC
1 parent 07b3c48
repl_helpers.ml
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2022 Nomadic Labs <contact@nomadic-labs.com> *)
(* *)
(* Permission is hereby granted, free of charge, to any person obtaining a *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *)
(* and/or sell copies of the Software, and to permit persons to whom the *)
(* Software is furnished to do so, subject to the following conditions: *)
(* *)
(* The above copyright notice and this permission notice shall be included *)
(* in all copies or substantial portions of the Software. *)
(* *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *)
(* DEALINGS IN THE SOFTWARE. *)
(* *)
(*****************************************************************************)
(* [error loc category msg] fails with the location of an error and a message,
returned by either the parser of the typechecker of the WASM reference
interpreter. *)
let error at category msg =
failwith "%s: %s: %s\n%!" (Source.string_of_region at) category msg
(* [trap_exn f] runs [f] and lifts it into the Lwt error monad. It traps any
exception. *)
let trap_exn f =
let open Lwt_result_syntax in
let open Tezos_webassembly_interpreter in
let open Tezos_webassembly_interpreter_extra in
let print_unknown ppf e =
Format.fprintf ppf "Unknown exception: %s" (Printexc.to_string e)
in
Lwt.catch
(fun () ->
let*! v = f () in
return v)
(function
| Decode.Code (at, msg) -> error at "decoding error" msg
| Parse.Syntax (at, msg) -> error at "syntax error" msg
| Valid.Invalid (at, msg) -> error at "invalid module" msg
| Import.Unknown (at, msg) -> error at "link failure" msg
| Eval.Link (at, msg) -> error at "link failure" msg
| Eval.Trap (at, msg) -> error at "runtime trap" msg
| Eval.Exhaustion (at, msg) -> error at "resource exhaustion" msg
| Eval.Crash (at, msg) -> error at "runtime crash" msg
| Encode.Code (at, msg) -> error at "encoding error" msg
| exn -> failwith "%a" (Data_encoding.Json.print_error ~print_unknown) exn)
(* [read_file file] reads a file and returns its content. This version prevent
channel manipulation and takes care of opening and closing it. *)
let read_file file =
let open Lwt_syntax in
Lwt_io.(
with_file ~mode:Input file (fun ic ->
let* len = length ic in
let buffer = Bytes.make (Int64.to_int len) '\000' in
let+ () = read_into_exactly ic buffer 0 (Int64.to_int len) in
Bytes.to_string buffer))
type integer_value_kind = [`U16 | `I32 | `I64 | `U128 | `U256]
type printable_value_kind = [integer_value_kind | `Hex | `String]
let integer_value_kind_of_string = function
| "uint16" | "u16" -> Some `U16
| "int32" | "i32" -> Some `I32
| "int64" | "i64" -> Some `I64
| "uint128" | "u128" -> Some `U128
| "uint256" | "u256" -> Some `U256
| _ -> None
let integer_value_kind_to_string = function
| `U16 -> "u16"
| `I32 -> "i32"
| `I64 -> "i64"
| `U128 -> "u128"
| `U256 -> "u256"
let value_kind_length = function
| `U16 -> 2
| `I32 -> 4
| `I64 -> 8
| `U128 -> 16
| `U256 -> 32
let printable_value_kind_of_string = function
| "hex" -> Some `Hex
| "string" -> Some `String
| k -> integer_value_kind_of_string k
let print_wasm_encoded_value (kind : printable_value_kind) value =
let open Result_syntax in
match kind with
| `Hex -> return (Format.asprintf "%a" Hex.pp (Hex.of_string value))
| `String -> return value
| #integer_value_kind as kind ->
let kind_length = value_kind_length kind in
if kind_length <> String.length value then
Error
(Format.sprintf
"%s values must be %d bytes long"
(integer_value_kind_to_string kind)
kind_length)
else return (Z.of_bits value |> Z.to_string)
Computing file changes ...