Merge branch 'feature/add-hashes' into 'dev'

add hashes and support for bytes

See merge request ligolang/ligo!69

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])

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 _), () ->

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)

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
+  )
+

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

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

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

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 ;

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 "@[<v2>%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 "@[<v2>%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 () ->

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

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)
@@ -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) @@