balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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

Browse Source 
add hashes and support for bytes

See merge request ligolang/ligo!69
This commit is contained in:
Gabriel Alfour 2019-09-07 17:04:07 +00:00
commit dec2ffd2ed
11 changed files with 86 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
src/ast_simplified/combinators.ml
View File

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

2
src/compiler/uncompiler.ml
View File

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

8
src/contracts/bytes_arithmetic.ligo Normal file
View File

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

20
src/main/display.ml
View File

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

4
src/mini_c/PP.ml
View File

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

5
src/operators/operators.ml
View File

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

17
src/simplify/pascaligo.ml
View File

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

21
src/test/integration_tests.ml
View File

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

35
src/test/test_helpers.ml
View File

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

4
src/test/typer_tests.ml
View File

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

9
src/transpiler/transpiler.ml
View File

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