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

some more operators

Browse Source
This commit is contained in:
Galfour 2019-06-10 01:41:02 +00:00
parent 9fd0206e9f
commit f4fc06ce72
4 changed files with 84 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
src/ast_typed/combinators.ml
View File

@ -15,6 +15,8 @@ let make_n_t type_name type_value = { type_name ; type_value }
let t_bool ?s () : type_value = make_t (T_constant ("bool", [])) s
let t_string ?s () : type_value = make_t (T_constant ("string", [])) s
let t_bytes ?s () : type_value = make_t (T_constant ("bytes", [])) s
let t_key ?s () : type_value = make_t (T_constant ("key", [])) s
let t_key_hash ?s () : type_value = make_t (T_constant ("key_hash", [])) s
let t_int ?s () : type_value = make_t (T_constant ("int", [])) s
let t_address ?s () : type_value = make_t (T_constant ("address", [])) s
let t_operation ?s () : type_value = make_t (T_constant ("operation", [])) s
@ -93,6 +95,18 @@ let get_t_list (t:type_value) : type_value result = match t.type_value' with
| T_constant ("list", [o]) -> ok o
| _ -> simple_fail "not a list"
let get_t_key (t:type_value) : unit result = match t.type_value' with
| T_constant ("key", []) -> ok ()
| _ -> simple_fail "not a key"
let get_t_signature (t:type_value) : unit result = match t.type_value' with
| T_constant ("signature", []) -> ok ()
| _ -> simple_fail "not a signature"
let get_t_key_hash (t:type_value) : unit result = match t.type_value' with
| T_constant ("key_hash", []) -> ok ()
| _ -> simple_fail "not a key_hash"
let get_t_tuple (t:type_value) : type_value list result = match t.type_value' with
| T_tuple lst -> ok lst
| _ -> simple_fail "not a tuple"
@ -137,6 +151,9 @@ let assert_t_map = fun t ->
let is_t_map = Function.compose to_bool get_t_map
let assert_t_tez : type_value -> unit result = get_t_tez
let assert_t_key = get_t_key
let assert_t_signature = get_t_signature
let assert_t_key_hash = get_t_key_hash
let assert_t_list t =
let%bind _ = get_t_list t in

10
src/compiler/compiler_program.ml
View File

@ -16,6 +16,16 @@ let get_predicate : string -> type_value -> expression list -> predicate result
| Some x -> ok x
| None -> (
match s with
| "NONE" -> (
let%bind ty' = Mini_c.get_t_option ty in
let%bind m_ty = Compiler_type.type_ ty' in
ok @@ simple_unary @@ prim ~children:[m_ty] I_NONE
)
| "UNPACK" -> (
let%bind ty' = Mini_c.get_t_option ty in
let%bind m_ty = Compiler_type.type_ ty' in
ok @@ simple_unary @@ prim ~children:[m_ty] I_UNPACK
)
| "MAP_REMOVE" ->
let%bind v = match lst with
| [ _ ; expr ] ->

57
src/operators/operators.ml
View File

@ -42,6 +42,9 @@ module Simplify = struct
("bool" , "bool") ;
("operation" , "operation") ;
("address" , "address") ;
("key" , "key") ;
("key_hash" , "key_hash") ;
("signature" , "signature") ;
("timestamp" , "timestamp") ;
("contract" , "contract") ;
("list" , "list") ;
@ -76,7 +79,7 @@ module Simplify = struct
("Bytes.pack" , "PACK") ;
("Crypto.hash" , "HASH") ;
("Operation.transaction" , "CALL") ;
("Operation.get_contract" , "GET_CONTRACT") ;
("Operation.get_contract" , "CONTRACT") ;
("sender" , "SENDER") ;
("unit" , "UNIT") ;
("source" , "SOURCE") ;
@ -126,7 +129,7 @@ module Simplify = struct
("List.iter", "ITER") ;
("Operation.transaction" , "CALL") ;
("Operation.get_contract" , "GET_CONTRACT") ;
("Operation.get_contract" , "CONTRACT") ;
("int" , "INT") ;
("abs" , "ABS") ;
("unit" , "UNIT") ;
@ -243,9 +246,15 @@ module Typer = struct
let size = typer_1 "SIZE" @@ fun t ->
let%bind () =
Assert.assert_true @@
(is_t_map t || is_t_list t) in
(is_t_map t || is_t_list t || is_t_string t) in
ok @@ t_nat ()
let slice = typer_3 "SLICE" @@ fun i j s ->
let%bind () =
Assert.assert_true @@
(is_t_nat i && is_t_nat j && is_t_string s) in
ok @@ t_string ()
let failwith_ = typer_1 "FAILWITH" @@ fun t ->
let%bind () =
Assert.assert_true @@
@ -269,10 +278,28 @@ module Typer = struct
trace_option (simple_error "untyped UNPACK") @@
output_opt
let crypto_hash = typer_1 "HASH" @@ fun t ->
let hash256 = typer_1 "SHA256" @@ fun t ->
let%bind () = assert_t_bytes t in
ok @@ t_bytes ()
let hash512 = typer_1 "SHA512" @@ fun t ->
let%bind () = assert_t_bytes t in
ok @@ t_bytes ()
let blake2b = typer_1 "BLAKE2b" @@ fun t ->
let%bind () = assert_t_bytes t in
ok @@ t_bytes ()
let hash_key = typer_1 "HASH_KEY" @@ fun t ->
let%bind () = assert_t_key t in
ok @@ t_key_hash ()
let check_signature = typer_3 "CHECK_SIGNATURE" @@ fun k s b ->
let%bind () = assert_t_key k in
let%bind () = assert_t_signature s in
let%bind () = assert_t_bytes b in
ok @@ t_bool ()
let sender = constant "SENDER" @@ t_address ()
let source = constant "SOURCE" @@ t_address ()
@ -281,6 +308,8 @@ module Typer = struct
let amount = constant "AMOUNT" @@ t_tez ()
let address = constant "ADDRESS" @@ t_address ()
let now = constant "NOW" @@ t_timestamp ()
let transaction = typer_3 "CALL" @@ fun param amount contract ->
@ -367,7 +396,11 @@ module Typer = struct
get_force ;
bytes_pack ;
bytes_unpack ;
crypto_hash ;
hash256 ;
hash512 ;
blake2b ;
hash_key ;
check_signature ;
sender ;
source ;
unit ;
@ -376,6 +409,8 @@ module Typer = struct
get_contract ;
abs ;
now ;
slice ;
address ;
]
end
@ -407,6 +442,8 @@ module Compiler = struct
("NEG" , simple_unary @@ prim I_NEG) ;
("OR" , simple_binary @@ prim I_OR) ;
("AND" , simple_binary @@ prim I_AND) ;
("XOR" , simple_binary @@ prim I_XOR) ;
("NOT" , simple_unary @@ prim I_NOT) ;
("PAIR" , simple_binary @@ prim I_PAIR) ;
("CAR" , simple_unary @@ prim I_CAR) ;
("CDR" , simple_unary @@ prim I_CDR) ;
@ -428,12 +465,22 @@ module Compiler = struct
("CONS" , simple_binary @@ prim I_CONS) ;
("UNIT" , simple_constant @@ prim I_UNIT) ;
("AMOUNT" , simple_constant @@ prim I_AMOUNT) ;
("ADDRESS" , simple_constant @@ prim I_ADDRESS) ;
("NOW" , simple_constant @@ prim I_NOW) ;
("CALL" , simple_ternary @@ prim I_TRANSFER_TOKENS) ;
("SOURCE" , simple_constant @@ prim I_SOURCE) ;
("SENDER" , simple_constant @@ prim I_SENDER) ;
("MAP_ADD" , simple_ternary @@ seq [dip (i_some) ; prim I_UPDATE ]) ;
("MAP_UPDATE" , simple_ternary @@ prim I_UPDATE) ;
("SLICE" , simple_ternary @@ prim I_SLICE) ;
("SHA256" , simple_unary @@ prim I_SHA256) ;
("SHA512" , simple_unary @@ prim I_SHA512) ;
("BLAKE2B" , simple_unary @@ prim I_BLAKE2B) ;
("CHECK_SIGNATURE" , simple_ternary @@ prim I_CHECK_SIGNATURE) ;
("HASH_KEY" , simple_unary @@ prim I_HASH_KEY) ;
("PACK" , simple_unary @@ prim I_PACK) ;
]
(* Some complex predicates will need to be added in compiler/compiler_program *)
end

3
src/test/test_helpers.ml
View File

@ -5,7 +5,7 @@ type test =
| Test_suite of (string * test list)
| Test of test_case
let error_pp out (e : error) =
let rec error_pp out (e : error) =
let open JSON_string_utils in
let message =
let opt = e |> member "message" |> string in
@ -30,6 +30,7 @@ let error_pp out (e : error) =
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
Format.fprintf out "%s%s%s.\n%s%s" title error_code message data infos