diff --git a/src/ast_simplified/combinators.ml b/src/ast_simplified/combinators.ml index e130e033c..622e1039c 100644 --- a/src/ast_simplified/combinators.ml +++ b/src/ast_simplified/combinators.ml @@ -57,7 +57,9 @@ let e_bool ?loc b : expression = Location.wrap ?loc @@ E_literal (Literal_bool let e_string ?loc s : expression = Location.wrap ?loc @@ E_literal (Literal_string s) let e_address ?loc s : expression = Location.wrap ?loc @@ E_literal (Literal_address s) let e_tez ?loc s : expression = Location.wrap ?loc @@ E_literal (Literal_tez s) -let e_bytes ?loc b : expression = Location.wrap ?loc @@ E_literal (Literal_bytes (Bytes.of_string b)) +let e_bytes ?loc b : expression result = + let%bind bytes = generic_try (simple_error "bad hex to bytes") (fun () -> Hex.to_bytes (`Hex b)) in + ok @@ Location.wrap ?loc @@ E_literal (Literal_bytes bytes) let e_record ?loc map : expression = Location.wrap ?loc @@ E_record map let e_tuple ?loc lst : expression = Location.wrap ?loc @@ E_tuple lst let e_some ?loc s : expression = Location.wrap ?loc @@ E_constant ("SOME", [s]) diff --git a/src/compiler/uncompiler.ml b/src/compiler/uncompiler.ml index a26cccc20..c0f8aa16b 100644 --- a/src/compiler/uncompiler.ml +++ b/src/compiler/uncompiler.ml @@ -45,6 +45,8 @@ let rec translate_value (Ex_typed_value (ty, value)) : value result = ok @@ D_bool b | (String_t _), s -> ok @@ D_string s + | (Bytes_t _), b -> + ok @@ D_bytes (Tezos_stdlib.MBytes.to_bytes b) | (Address_t _), s -> ok @@ D_string (Alpha_context.Contract.to_b58check s) | (Unit_t _), () -> diff --git a/src/contracts/bytes_arithmetic.ligo b/src/contracts/bytes_arithmetic.ligo new file mode 100644 index 000000000..c03270a18 --- /dev/null +++ b/src/contracts/bytes_arithmetic.ligo @@ -0,0 +1,8 @@ +function concat_op (const s : bytes) : bytes is + begin skip end with bytes_concat(s , ("7070" : bytes)) + +function slice_op (const s : bytes) : bytes is + begin skip end with bytes_slice(1n , 2n , s) + +function hasherman (const s : bytes) : bytes is + begin skip end with sha_256(s) diff --git a/src/main/display.ml b/src/main/display.ml index a68999f28..ab35528cb 100644 --- a/src/main/display.ml +++ b/src/main/display.ml @@ -1,6 +1,8 @@ open Trace -let error_pp out (e : error) = +let dev = false + +let rec error_pp out (e : error) = let open JSON_string_utils in let message = let opt = e |> member "message" |> string in @@ -26,6 +28,12 @@ let error_pp out (e : error) = | `List lst -> lst | `Null -> [] | x -> [ x ] in + let children = + let infos = e |> member "children" in + match infos with + | `List lst -> lst + | `Null -> [] + | x -> [ x ] in let location = let opt = e |> member "data" |> member "location" |> string in let aux prec cur = @@ -38,5 +46,11 @@ let error_pp out (e : error) = | Some s -> s ^ ". " in let print x = Format.fprintf out x in - print "%s%s%s%s%s" location title error_code message data - (* Format.fprintf out "%s%s%s.\n%s%s" title error_code message data infos *) + if not dev then ( + print "%s%s%s%s%s" location title error_code message data + ) else ( + print "%s%s%s.\n%s%s\n%a\n%a\n" title error_code message data location + (Format.pp_print_list error_pp) infos + (Format.pp_print_list error_pp) children + ) + diff --git a/src/mini_c/PP.ml b/src/mini_c/PP.ml index 7377c4c85..13fb005fc 100644 --- a/src/mini_c/PP.ml +++ b/src/mini_c/PP.ml @@ -51,7 +51,9 @@ let rec value ppf : value -> unit = function | D_tez n -> fprintf ppf "%dtz" n | D_unit -> fprintf ppf "unit" | D_string s -> fprintf ppf "\"%s\"" s - | D_bytes _ -> fprintf ppf "[bytes]" + | D_bytes x -> + let (`Hex hex) = Hex.of_bytes x in + fprintf ppf "0x%s" hex | D_pair (a, b) -> fprintf ppf "(%a), (%a)" value a value b | D_left a -> fprintf ppf "L(%a)" value a | D_right b -> fprintf ppf "R(%a)" value b diff --git a/src/operators/operators.ml b/src/operators/operators.ml index 67c0cdb28..cdf983b6a 100644 --- a/src/operators/operators.ml +++ b/src/operators/operators.ml @@ -74,6 +74,8 @@ module Simplify = struct ("bitwise_xor" , "XOR") ; ("string_concat" , "CONCAT") ; ("string_slice" , "SLICE") ; + ("bytes_concat" , "CONCAT") ; + ("bytes_slice" , "SLICE") ; ("set_empty" , "SET_EMPTY") ; ("set_mem" , "SET_MEM") ; ("set_add" , "SET_ADD") ; @@ -83,6 +85,9 @@ module Simplify = struct ("list_map" , "LIST_MAP") ; ("map_iter" , "MAP_ITER") ; ("map_map" , "MAP_MAP") ; + ("sha_256" , "SHA256") ; + ("sha_512" , "SHA512") ; + ("blake2b" , "BLAKE2b") ; ] let type_constants = type_constants diff --git a/src/simplify/pascaligo.ml b/src/simplify/pascaligo.ml index c7d803f1f..4aeab4d2a 100644 --- a/src/simplify/pascaligo.ml +++ b/src/simplify/pascaligo.ml @@ -36,6 +36,16 @@ module Errors = struct ] in error ~data title message + let bad_bytes loc str = + let title () = "bad bytes string" in + let message () = + Format.asprintf "bytes string contained non-hexadecimal chars" in + let data = [ + ("location", fun () -> Format.asprintf "%a" Location.pp loc) ; + ("bytes", fun () -> str) ; + ] in + error ~data title message + let unsupported_entry_decl decl = let title () = "entry point declarations" in let message () = @@ -385,7 +395,12 @@ let rec simpl_expression (t:Raw.expr) : expr result = let ((expr , type_expr) , loc) = r_split a in let%bind expr' = simpl_expression expr in let%bind type_expr' = simpl_type_expression type_expr in - return @@ e_annotation ~loc expr' type_expr' + match (Location.unwrap expr', type_expr') with + | (E_literal (Literal_string str) , T_constant ("bytes" , [])) -> + trace_strong (bad_bytes loc str) @@ + e_bytes ~loc str + | _ -> + return @@ e_annotation ~loc expr' type_expr' ) | EVar c -> ( let (c' , loc) = r_split c in diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index df6f11f5d..4432f07b9 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -170,6 +170,26 @@ let string_arithmetic () : unit result = let%bind () = expect_fail program "slice_op" (e_string "ba") in ok () +let bytes_arithmetic () : unit result = + let%bind program = type_file "./contracts/bytes_arithmetic.ligo" in + let%bind foo = e_bytes "0f00" in + let%bind foototo = e_bytes "0f007070" in + let%bind toto = e_bytes "7070" in + let%bind empty = e_bytes "" in + let%bind tata = e_bytes "7a7a7a7a" in + let%bind at = e_bytes "7a7a" in + let%bind ba = e_bytes "ba" in + let%bind () = expect_eq program "concat_op" foo foototo in + let%bind () = expect_eq program "concat_op" empty toto in + let%bind () = expect_eq program "slice_op" tata at in + let%bind () = expect_fail program "slice_op" foo in + let%bind () = expect_fail program "slice_op" ba in + let%bind b1 = run_simplityped program "hasherman" foo in + let%bind () = expect_eq program "hasherman" foo b1 in + let%bind b3 = run_simplityped program "hasherman" foototo in + let%bind () = Assert.assert_fail @@ Ast_simplified.Misc.assert_value_eq (b3 , b1) in + ok () + let set_arithmetic () : unit result = let%bind program = type_file "./contracts/set_arithmetic.ligo" in let%bind program_1 = type_file "./contracts/set_arithmetic-1.ligo" in @@ -656,6 +676,7 @@ let main = test_suite "Integration (End to End)" [ test "arithmetic" arithmetic ; test "bitiwse_arithmetic" bitwise_arithmetic ; test "string_arithmetic" string_arithmetic ; + test "bytes_arithmetic" bytes_arithmetic ; test "set_arithmetic" set_arithmetic ; test "unit" unit_expression ; test "string" string_expression ; diff --git a/src/test/test_helpers.ml b/src/test/test_helpers.ml index 3eee3f701..f1a51a794 100644 --- a/src/test/test_helpers.ml +++ b/src/test/test_helpers.ml @@ -21,41 +21,6 @@ let wrap_test_raw f = | Error err -> Format.printf "%a\n%!" Ligo.Display.error_pp (err ()) -(* let rec error_pp out (e : error) = - * let open JSON_string_utils in - * let message = - * let opt = e |> member "message" |> string in - * let msg = Option.unopt ~default:"" opt in - * if msg = "" - * then "" - * else ": " ^ msg in - * let error_code = - * let error_code = e |> member "error_code" in - * match error_code with - * | `Null -> "" - * | _ -> " (" ^ (J.to_string error_code) ^ ")" in - * let title = - * let opt = e |> member "title" |> string in - * Option.unopt ~default:"" opt in - * let data = - * let data = e |> member "data" in - * match data with - * | `Null -> "" - * | _ -> " " ^ (J.to_string data) ^ "\n" in - * let infos = - * let infos = e |> member "infos" in - * match infos with - * | `Null -> "" - * | `List lst -> Format.asprintf "@[%a@]" PP_helpers.(list_sep error_pp (tag "@,")) lst - * | _ -> " " ^ (J.to_string infos) ^ "\n" in - * let children = - * let children = e |> member "children" in - * match children with - * | `Null -> "" - * | `List lst -> Format.asprintf "@[%a@]" PP_helpers.(list_sep error_pp (tag "@,")) lst - * | _ -> " " ^ (J.to_string children) ^ "\n" in - * Format.fprintf out "%s%s%s.\n%s%s%s" title error_code message data infos children *) - let test name f = Test ( Alcotest.test_case name `Quick @@ fun () -> diff --git a/src/test/typer_tests.ml b/src/test/typer_tests.ml index 89500c2a7..b61da4bd0 100644 --- a/src/test/typer_tests.ml +++ b/src/test/typer_tests.ml @@ -36,7 +36,9 @@ module TestExpressions = struct let int () : unit result = test_expression I.(e_int 32) O.(t_int ()) let bool () : unit result = test_expression I.(e_bool true) O.(t_bool ()) let string () : unit result = test_expression I.(e_string "s") O.(t_string ()) - let bytes () : unit result = test_expression I.(e_bytes "b") O.(t_bytes ()) + let bytes () : unit result = + let%bind b = I.e_bytes "0b" in + test_expression b O.(t_bytes ()) let lambda () : unit result = test_expression diff --git a/src/transpiler/transpiler.ml b/src/transpiler/transpiler.ml index e86254f6b..7d4db9321 100644 --- a/src/transpiler/transpiler.ml +++ b/src/transpiler/transpiler.ml @@ -102,6 +102,7 @@ let rec translate_type (t:AST.type_value) : type_value result = | T_constant ("nat", []) -> ok (T_base Base_nat) | T_constant ("tez", []) -> ok (T_base Base_tez) | T_constant ("string", []) -> ok (T_base Base_string) + | T_constant ("bytes", []) -> ok (T_base Base_bytes) | T_constant ("address", []) -> ok (T_base Base_address) | T_constant ("timestamp", []) -> ok (T_base Base_timestamp) | T_constant ("unit", []) -> ok (T_base Base_unit) @@ -714,7 +715,7 @@ let rec untranspile (v : value) (t : AST.type_value) : AST.annotated_expression | T_constant ("timestamp", []) -> ( let%bind n = trace_strong (wrong_mini_c_value "timestamp" v) @@ - get_timestamp v in + get_timestamp v in return (E_literal (Literal_timestamp n)) ) | T_constant ("tez", []) -> ( @@ -729,6 +730,12 @@ let rec untranspile (v : value) (t : AST.type_value) : AST.annotated_expression get_string v in return (E_literal (Literal_string n)) ) + | T_constant ("bytes", []) -> ( + let%bind n = + trace_strong (wrong_mini_c_value "bytes" v) @@ + get_bytes v in + return (E_literal (Literal_bytes n)) + ) | T_constant ("address", []) -> ( let%bind n = trace_strong (wrong_mini_c_value "address" v) @@