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

add type map_or_big_map to solve issue of typing big_map_empty from map_add

Browse Source
This commit is contained in:
Pierre-Emmanuel Wulfman 2020-03-25 19:10:04 +01:00
parent 330c48e66a
commit 6a9547e910
16 changed files with 72 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
src/bin/expect_tests/ligo_interpreter_tests.ml
View File

@ -43,12 +43,12 @@ let%expect_test _ =
val map_finds = Some(2 : int)
val map_finds_fail = "failed map find" : failure
val map_empty = { ; 0 = ([]) ; 1 = ([]) }
val m = [ ; "one" : string -> 1 : int ; "two" : string -> 2 : int ; "three" : string -> 3 : int]
val m = [ ; "one" : string -> 1 : int ; "three" : string -> 3 : int ; "two" : string -> 2 : int]
val map_fold = 4 : int
val map_iter = unit
val map_map = [ ; "one" : string -> 4 : int ; "two" : string -> 5 : int ; "three" : string -> 8 : int]
val map_map = [ ; "one" : string -> 4 : int ; "three" : string -> 8 : int ; "two" : string -> 5 : int]
val map_mem = { ; 0 = (true) ; 1 = (false) }
val map_remove = { ; 0 = ([ ; "two" : string -> 2 : int ; "three" : string -> 3 : int]) ; 1 = ([ ; "one" : string -> 1 : int ; "two" : string -> 2 : int ; "three" : string -> 3 : int]) }
val map_remove = { ; 0 = ([ ; "three" : string -> 3 : int ; "two" : string -> 2 : int]) ; 1 = ([ ; "one" : string -> 1 : int ; "three" : string -> 3 : int ; "two" : string -> 2 : int]) }
val map_update = { ; 0 = ([ ; "one" : string -> 1 : int]) ; 1 = ([]) ; 2 = ([]) ; 3 = ([ ; "one" : string -> 1 : int]) }
val s = { ; 1 : int ; 2 : int ; 3 : int}
val set_add = { ; 0 = ({ ; 1 : int ; 2 : int ; 3 : int}) ; 1 = ({ ; 1 : int ; 2 : int ; 3 : int ; 4 : int}) ; 2 = ({ ; 1 : int}) }

1
src/passes/10-interpreter/interpreter.ml
View File

@ -171,6 +171,7 @@ let rec apply_operator : Ast_typed.constant' -> value list -> value result =
eval body env'
)
init elts
| ( C_MAP_EMPTY , []) -> ok @@ V_Map ([])
| ( C_MAP_FOLD , [ V_Func_val (arg_name, body, env) ; V_Map kvs ; init ] ) ->
bind_fold_list
(fun prev kv ->

2
src/passes/10-transpiler/transpiler.ml
View File

@ -141,6 +141,8 @@ let rec transpile_type (t:AST.type_expression) : type_value result =
| T_operator (TC_big_map (key,value)) ->
let%bind kv' = bind_map_pair transpile_type (key, value) in
ok (T_big_map kv')
| T_operator (TC_map_or_big_map (_,_)) ->
fail @@ corner_case ~loc:"transpiler" "TC_map_or_big_map should be resolve before transpilation"
| T_operator (TC_list t) ->
let%bind t' = transpile_type t in
ok (T_list t')

16
src/passes/10-transpiler/untranspiler.ml
View File

@ -160,30 +160,32 @@ let rec untranspile (v : value) (t : AST.type_expression) : AST.expression resul
let%bind v' = untranspile v v_ty in
ok (k', v') in
bind_map_list aux map in
let map' = List.sort_uniq compare map' in
let aux = fun prev (k, v) ->
let (k', v') = (k , v ) in
return @@ E_constant {cons_name=C_MAP_ADD;arguments=[k' ; v' ; prev]}
in
let%bind init = return @@ E_constant {cons_name=C_MAP_EMPTY;arguments=[]} in
bind_fold_list aux init map'
bind_fold_right_list aux init map'
)
| TC_big_map (k_ty, v_ty) -> (
let%bind map =
let%bind big_map =
trace_strong (wrong_mini_c_value "big_map" v) @@
get_big_map v in
let%bind map' =
let%bind big_map' =
let aux = fun (k, v) ->
let%bind k' = untranspile k k_ty in
let%bind v' = untranspile v v_ty in
ok (k', v') in
bind_map_list aux map in
let map' = List.sort_uniq compare map' in
bind_map_list aux big_map in
let big_map' = List.sort_uniq compare big_map' in
let aux = fun prev (k, v) ->
return @@ E_constant {cons_name=C_MAP_ADD;arguments=[k ; v ; prev]}
in
let%bind init = return @@ E_constant {cons_name=C_MAP_EMPTY;arguments=[]} in
bind_fold_list aux init map'
let%bind init = return @@ E_constant {cons_name=C_BIG_MAP_EMPTY;arguments=[]} in
bind_fold_right_list aux init big_map'
)
| TC_map_or_big_map (_, _) -> fail @@ corner_case ~loc:"untranspiler" "should not be present in mini-c"
| TC_list ty -> (
let%bind lst =
trace_strong (wrong_mini_c_value "list" v) @@

6
src/passes/4-imperative_to_sugar/imperative_to_sugar.ml
View File

@ -154,6 +154,9 @@ and compile_type_operator : I.type_operator -> O.type_operator result =
| TC_big_map (k,v) ->
let%bind (k,v) = bind_map_pair compile_type_expression (k,v) in
ok @@ O.TC_big_map (k,v)
| TC_map_or_big_map (k,v) ->
let%bind (k,v) = bind_map_pair compile_type_expression (k,v) in
ok @@ O.TC_map_or_big_map (k,v)
| TC_arrow (i,o) ->
let%bind (i,o) = bind_map_pair compile_type_expression (i,o) in
ok @@ O.TC_arrow (i,o)
@ -569,6 +572,9 @@ and uncompile_type_operator : O.type_operator -> I.type_operator result =
| TC_big_map (k,v) ->
let%bind (k,v) = bind_map_pair uncompile_type_expression (k,v) in
ok @@ I.TC_big_map (k,v)
| TC_map_or_big_map (k,v) ->
let%bind (k,v) = bind_map_pair uncompile_type_expression (k,v) in
ok @@ I.TC_map_or_big_map (k,v)
| TC_arrow (i,o) ->
let%bind (i,o) = bind_map_pair uncompile_type_expression (i,o) in
ok @@ I.TC_arrow (i,o)

14
src/passes/6-sugar_to_core/sugar_to_core.ml
View File

@ -55,6 +55,9 @@ and idle_type_operator : I.type_operator -> O.type_operator result =
| TC_big_map (k,v) ->
let%bind (k,v) = bind_map_pair idle_type_expression (k,v) in
ok @@ O.TC_big_map (k,v)
| TC_map_or_big_map (k,v) ->
let%bind (k,v) = bind_map_pair idle_type_expression (k,v) in
ok @@ O.TC_map_or_big_map (k,v)
| TC_arrow (i,o) ->
let%bind (i,o) = bind_map_pair idle_type_expression (i,o) in
ok @@ O.TC_arrow (i,o)
@ -115,16 +118,16 @@ let rec compile_expression : I.expression -> O.expression result =
return @@ E_constant {cons_name=C_MAP_ADD;arguments=[k' ; v' ; prev]}
in
let%bind init = return @@ E_constant {cons_name=C_MAP_EMPTY;arguments=[]} in
bind_fold_list aux init map
bind_fold_right_list aux init map
)
| I.E_big_map big_map -> (
let map = List.sort_uniq compare big_map in
let big_map = List.sort_uniq compare big_map in
let aux = fun prev (k, v) ->
let%bind (k', v') = bind_map_pair (compile_expression) (k, v) in
return @@ E_constant {cons_name=C_BIG_MAP_ADD;arguments=[k' ; v' ; prev]}
return @@ E_constant {cons_name=C_MAP_ADD;arguments=[k' ; v' ; prev]}
in
let%bind init = return @@ E_constant {cons_name=C_BIG_MAP_EMPTY;arguments=[]} in
bind_fold_list aux init map
bind_fold_right_list aux init big_map
)
| I.E_list lst ->
let%bind lst' = bind_map_list (compile_expression) lst in
@ -258,6 +261,9 @@ and uncompile_type_operator : O.type_operator -> I.type_operator result =
| TC_big_map (k,v) ->
let%bind (k,v) = bind_map_pair uncompile_type_expression (k,v) in
ok @@ I.TC_big_map (k,v)
| TC_map_or_big_map (k,v) ->
let%bind (k,v) = bind_map_pair uncompile_type_expression (k,v) in
ok @@ I.TC_map_or_big_map (k,v)
| TC_arrow (i,o) ->
let%bind (i,o) = bind_map_pair uncompile_type_expression (i,o) in
ok @@ I.TC_arrow (i,o)

2
src/passes/8-typer-new/solver.ml
View File

@ -70,6 +70,7 @@ module Wrap = struct
| TC_set s -> (C_set, [s])
| TC_map ( k , v ) -> (C_map, [k;v])
| TC_big_map ( k , v) -> (C_big_map, [k;v])
| TC_map_or_big_map ( k , v) -> (C_map, [k;v])
| TC_arrow ( arg , ret ) -> (C_arrow, [ arg ; ret ])
| TC_list l -> (C_list, [l])
| TC_contract c -> (C_contract, [c])
@ -103,6 +104,7 @@ module Wrap = struct
| TC_set s -> (C_set , [s])
| TC_map ( k , v ) -> (C_map , [k;v])
| TC_big_map ( k , v ) -> (C_big_map, [k;v])
| TC_map_or_big_map ( k , v) -> (C_map, [k;v])
| TC_contract c -> (C_contract, [c])
| TC_arrow ( arg , ret ) -> (C_arrow, [ arg ; ret ])
)

8
src/passes/8-typer-new/typer.ml
View File

@ -345,6 +345,10 @@ and evaluate_type (e:environment) (t:I.type_expression) : O.type_expression resu
let%bind k = evaluate_type e k in
let%bind v = evaluate_type e v in
ok @@ O.TC_big_map (k,v)
| TC_map_or_big_map (k,v) ->
let%bind k = evaluate_type e k in
let%bind v = evaluate_type e v in
ok @@ O.TC_map_or_big_map (k,v)
| TC_contract c ->
let%bind c = evaluate_type e c in
ok @@ O.TC_contract c
@ -837,6 +841,10 @@ let rec untype_type_expression (t:O.type_expression) : (I.type_expression) resul
let%bind k = untype_type_expression k in
let%bind v = untype_type_expression v in
ok @@ I.TC_big_map (k,v)
| O.TC_map_or_big_map (k,v) ->
let%bind k = untype_type_expression k in
let%bind v = untype_type_expression v in
ok @@ I.TC_map_or_big_map (k,v)
| O.TC_arrow ( arg , ret ) ->
let%bind arg' = untype_type_expression arg in
let%bind ret' = untype_type_expression ret in

20
src/passes/8-typer-old/typer.ml
View File

@ -381,6 +381,10 @@ and evaluate_type (e:environment) (t:I.type_expression) : O.type_expression resu
let%bind k = evaluate_type e k in
let%bind v = evaluate_type e v in
ok @@ O.TC_big_map (k,v)
| TC_map_or_big_map (k,v) ->
let%bind k = evaluate_type e k in
let%bind v = evaluate_type e v in
ok @@ O.TC_map_or_big_map (k,v)
| TC_arrow ( arg , ret ) ->
let%bind arg' = evaluate_type e arg in
let%bind ret' = evaluate_type e ret in
@ -602,21 +606,7 @@ and type_expression' : environment -> ?tv_opt:O.type_expression -> I.expression
let tv_val = get_type_expression val' in
let tv = match tv_opt with
Some (tv) -> tv
| None -> t_map tv_key tv_val ()
in
let%bind map' = type_expression' e ~tv_opt:tv map in
let tv_map = get_type_expression map' in
let tv_lst = [tv_key;tv_val;tv_map] in
let%bind (name', tv) = type_constant cst tv_lst tv_opt in
return (E_constant {cons_name=name';arguments=[key';val';map']}) tv
| E_constant {cons_name=C_BIG_MAP_ADD as cst; arguments=[key;value;map]} ->
let%bind key' = type_expression' e key in
let%bind val' = type_expression' e value in
let tv_key = get_type_expression key' in
let tv_val = get_type_expression val' in
let tv = match tv_opt with
Some (tv) -> tv
| None -> t_big_map tv_key tv_val ()
| None -> t_map_or_big_map tv_key tv_val ()
in
let%bind map' = type_expression' e ~tv_opt:tv map in
let tv_map = get_type_expression map' in

12
src/passes/operators/operators.ml
View File

@ -624,7 +624,16 @@ module Typer = struct
let map_empty = typer_0 "MAP_EMPTY" @@ fun tv_opt ->
match tv_opt with
| None -> simple_fail "untyped MAP_EMPTY"
| Some t -> ok t
| Some t ->
let%bind (src, dst) = get_t_map t in
ok @@ t_map src dst ()
let big_map_empty = typer_0 "BIG_MAP_EMPTY" @@ fun tv_opt ->
match tv_opt with
| None -> simple_fail "untyped BIG_MAP_EMPTY"
| Some t ->
let%bind (src, dst) = get_t_big_map t in
ok @@ t_big_map src dst ()
let map_add : typer = typer_3 "MAP_ADD" @@ fun k v m ->
let%bind (src, dst) = bind_map_or (get_t_map , get_t_big_map) m in
@ -1171,6 +1180,7 @@ module Typer = struct
| C_LIST_FOLD -> ok @@ list_fold ;
(* MAP *)
| C_MAP_EMPTY -> ok @@ map_empty ;
| C_BIG_MAP_EMPTY -> ok @@ big_map_empty ;
| C_MAP_ADD -> ok @@ map_add ;
| C_MAP_REMOVE -> ok @@ map_remove ;
| C_MAP_UPDATE -> ok @@ map_update ;

3
src/stages/4-ast_typed/combinators.ml
View File

@ -64,6 +64,7 @@ let t_pair a b ?s () : type_expression = ez_t_record [(Label "0",a) ; (Label "
let t_map key value ?s () = make_t (T_operator (TC_map (key , value))) s
let t_big_map key value ?s () = make_t (T_operator (TC_big_map (key , value))) s
let t_map_or_big_map key value ?s () = make_t (T_operator (TC_map_or_big_map (key,value))) s
let t_sum m ?s () : type_expression = make_t (T_sum m) s
let make_t_ez_sum (lst:(constructor' * type_expression) list) : type_expression =
@ -190,11 +191,13 @@ let get_t_record (t:type_expression) : type_expression label_map result = match
let get_t_map (t:type_expression) : (type_expression * type_expression) result =
match t.type_content with
| T_operator (TC_map (k,v)) -> ok (k, v)
| T_operator (TC_map_or_big_map (k,v)) -> ok (k, v)
| _ -> fail @@ Errors.not_a_x_type "map" t ()
let get_t_big_map (t:type_expression) : (type_expression * type_expression) result =
match t.type_content with
| T_operator (TC_big_map (k,v)) -> ok (k, v)
| T_operator (TC_map_or_big_map (k,v)) -> ok (k, v)
| _ -> fail @@ Errors.not_a_x_type "big_map" t ()
let get_t_map_key : type_expression -> type_expression result = fun t ->

1
src/stages/4-ast_typed/combinators.mli
View File

@ -31,6 +31,7 @@ val ez_t_record : ( label * type_expression ) list -> ?s:S.type_expression -> un
val t_map : type_expression -> type_expression -> ?s:S.type_expression -> unit -> type_expression
val t_big_map : type_expression -> type_expression -> ?s:S.type_expression -> unit -> type_expression
val t_map_or_big_map : type_expression -> type_expression -> ?s:S.type_expression -> unit -> type_expression
val t_sum : type_expression constructor_map -> ?s:S.type_expression -> unit -> type_expression
val make_t_ez_sum : ( constructor' * type_expression ) list -> type_expression
val t_function : type_expression -> type_expression -> ?s:S.type_expression -> unit -> type_expression

9
src/stages/4-ast_typed/misc.ml
View File

@ -338,10 +338,11 @@ let rec assert_type_expression_eq (a, b: (type_expression * type_expression)) :
| TC_list la, TC_list lb
| TC_contract la, TC_contract lb
| TC_set la, TC_set lb -> ok @@ ([la], [lb])
| TC_map (ka,va), TC_map (kb,vb)
| TC_big_map (ka,va), TC_big_map (kb,vb) -> ok @@ ([ka;va] ,[kb;vb])
| (TC_option _ | TC_list _ | TC_contract _ | TC_set _ | TC_map _ | TC_big_map _ | TC_arrow _),
(TC_option _ | TC_list _ | TC_contract _ | TC_set _ | TC_map _ | TC_big_map _ | TC_arrow _ ) -> fail @@ different_operators opa opb
| (TC_map (ka,va) | TC_map_or_big_map (ka,va)), (TC_map (kb,vb) | TC_map_or_big_map (kb,vb))
| (TC_big_map (ka,va) | TC_map_or_big_map (ka,va)), (TC_big_map (kb,vb) | TC_map_or_big_map (kb,vb))
-> ok @@ ([ka;va] ,[kb;vb])
| (TC_option _ | TC_list _ | TC_contract _ | TC_set _ | TC_map _ | TC_big_map _ | TC_map_or_big_map _ | TC_arrow _),
(TC_option _ | TC_list _ | TC_contract _ | TC_set _ | TC_map _ | TC_big_map _ | TC_map_or_big_map _ | TC_arrow _ ) -> fail @@ different_operators opa opb
in
if List.length lsta <> List.length lstb then
fail @@ different_operator_number_of_arguments opa opb (List.length lsta) (List.length lstb)

1
src/stages/5-mini_c/PP.ml
View File

@ -217,7 +217,6 @@ and constant ppf : constant' -> unit = function
| C_MAP_FIND_OPT -> fprintf ppf "MAP_FIND_OP"
(* Big Maps *)
| C_BIG_MAP -> fprintf ppf "BIG_MAP"
| C_BIG_MAP_ADD -> fprintf ppf "BIG_MAP_ADD"
| C_BIG_MAP_EMPTY -> fprintf ppf "BIG_MAP_EMPTY"
| C_BIG_MAP_LITERAL -> fprintf ppf "BIG_MAP_LITERAL"
(* Crypto *)

2
src/stages/common/PP.ml
View File

@ -127,7 +127,6 @@ let constant ppf : constant' -> unit = function
| C_MAP_FIND_OPT -> fprintf ppf "MAP_FIND_OP"
(* Big Maps *)
| C_BIG_MAP -> fprintf ppf "BIG_MAP"
| C_BIG_MAP_ADD -> fprintf ppf "BIG_MAP_ADD"
| C_BIG_MAP_EMPTY -> fprintf ppf "BIG_MAP_EMPTY"
| C_BIG_MAP_LITERAL -> fprintf ppf "BIG_MAP_LITERAL"
(* Crypto *)
@ -266,6 +265,7 @@ module Ast_PP_type (PARAMETER : AST_PARAMETER_TYPE) = struct
| TC_set te -> Format.asprintf "set(%a)" f te
| TC_map (k, v) -> Format.asprintf "Map (%a,%a)" f k f v
| TC_big_map (k, v) -> Format.asprintf "Big Map (%a,%a)" f k f v
| TC_map_or_big_map (k, v) -> Format.asprintf "Map Or Big Map (%a,%a)" f k f v
| TC_arrow (k, v) -> Format.asprintf "arrow (%a,%a)" f k f v
| TC_contract te -> Format.asprintf "Contract (%a)" f te
in

6
src/stages/common/types.ml
View File

@ -53,6 +53,7 @@ module Ast_generic_type (PARAMETER : AST_PARAMETER_TYPE) = struct
| TC_set of type_expression
| TC_map of type_expression * type_expression
| TC_big_map of type_expression * type_expression
| TC_map_or_big_map of type_expression * type_expression
| TC_arrow of type_expression * type_expression
@ -66,6 +67,7 @@ module Ast_generic_type (PARAMETER : AST_PARAMETER_TYPE) = struct
| TC_set x -> TC_set (f x)
| TC_map (x , y) -> TC_map (f x , f y)
| TC_big_map (x , y)-> TC_big_map (f x , f y)
| TC_map_or_big_map (x , y)-> TC_map_or_big_map (f x , f y)
| TC_arrow (x, y) -> TC_arrow (f x, f y)
let bind_map_type_operator f = function
@ -75,6 +77,7 @@ module Ast_generic_type (PARAMETER : AST_PARAMETER_TYPE) = struct
| TC_set x -> let%bind x = f x in ok @@ TC_set x
| TC_map (x , y) -> let%bind x = f x in let%bind y = f y in ok @@ TC_map (x , y)
| TC_big_map (x , y)-> let%bind x = f x in let%bind y = f y in ok @@ TC_big_map (x , y)
| TC_map_or_big_map (x , y)-> let%bind x = f x in let%bind y = f y in ok @@ TC_map_or_big_map (x , y)
| TC_arrow (x , y)-> let%bind x = f x in let%bind y = f y in ok @@ TC_arrow (x , y)
let type_operator_name = function
@ -84,6 +87,7 @@ module Ast_generic_type (PARAMETER : AST_PARAMETER_TYPE) = struct
| TC_set _ -> "TC_set"
| TC_map _ -> "TC_map"
| TC_big_map _ -> "TC_big_map"
| TC_map_or_big_map _ -> "TC_map_or_big_map"
| TC_arrow _ -> "TC_arrow"
let type_expression'_of_string = function
@ -122,6 +126,7 @@ module Ast_generic_type (PARAMETER : AST_PARAMETER_TYPE) = struct
| TC_set x -> "TC_set" , [x]
| TC_map (x , y) -> "TC_map" , [x ; y]
| TC_big_map (x , y) -> "TC_big_map" , [x ; y]
| TC_map_or_big_map (x , y) -> "TC_map_or_big_map" , [x ; y]
| TC_arrow (x , y) -> "TC_arrow" , [x ; y]
let string_of_type_constant = function
@ -269,7 +274,6 @@ and constant' =
| C_MAP_FIND_OPT
(* Big Maps *)
| C_BIG_MAP
| C_BIG_MAP_ADD
| C_BIG_MAP_EMPTY
| C_BIG_MAP_LITERAL
(* Crypto *)