add E_big_map case in Ast

This commit is contained in:
Lesenechal Remi 2019-09-06 15:43:11 +02:00
parent a9f7bb39e4
commit e5b4d37af8
12 changed files with 61 additions and 8 deletions

View File

@ -41,6 +41,7 @@ let rec expression ppf (e:expression) = match Location.unwrap e with
| E_accessor (ae, p) -> fprintf ppf "%a.%a" expression ae access_path p
| E_record m -> fprintf ppf "record[%a]" (smap_sep_d expression) m
| E_map m -> fprintf ppf "map[%a]" (list_sep_d assoc_expression) m
| E_big_map m -> fprintf ppf "big_map[%a]" (list_sep_d assoc_expression) m
| E_list lst -> fprintf ppf "list[%a]" (list_sep_d expression) lst
| E_set lst -> fprintf ppf "set[%a]" (list_sep_d expression) lst
| E_look_up (ds, ind) -> fprintf ppf "(%a)[%a]" expression ds expression ind

View File

@ -43,6 +43,7 @@ let ez_t_sum (lst:(string * type_expression) list) : type_expression =
let t_function param result : type_expression = T_function (param, result)
let t_map key value = (T_constant ("map", [key ; value]))
let t_big_map key value = (T_constant ("big_map", [key ; value]))
let t_set key = (T_constant ("set", [key]))
let make_name (s : string) : name = s
@ -66,6 +67,7 @@ let e_some ?loc s : expression = Location.wrap ?loc @@ E_constant ("SOME", [s])
let e_none ?loc () : expression = Location.wrap ?loc @@ E_constant ("NONE", [])
let e_map_add ?loc k v old : expression = Location.wrap ?loc @@ E_constant ("MAP_ADD" , [k ; v ; old])
let e_map ?loc lst : expression = Location.wrap ?loc @@ E_map lst
let e_big_map ?loc lst : expression = Location.wrap ?loc @@ E_big_map lst
let e_set ?loc lst : expression = Location.wrap ?loc @@ E_set lst
let e_list ?loc lst : expression = Location.wrap ?loc @@ E_list lst
let e_pair ?loc a b : expression = Location.wrap ?loc @@ E_tuple [a; b]
@ -106,6 +108,7 @@ let e_typed_list ?loc lst t =
e_annotation ?loc (e_list lst) (t_list t)
let e_typed_map ?loc lst k v = e_annotation ?loc (e_map lst) (t_map k v)
let e_typed_big_map ?loc lst k v = e_annotation ?loc (e_big_map lst) (t_big_map k v)
let e_typed_set ?loc lst k = e_annotation ?loc (e_set lst) (t_set k)

View File

@ -120,7 +120,7 @@ let rec assert_value_eq (a, b: (expression * expression )) : unit result =
| E_record _, _ ->
simple_fail "comparing record with other stuff"
| E_map lsta, E_map lstb -> (
| (E_map lsta, E_map lstb | E_big_map lsta, E_big_map lstb) -> (
let%bind lst = generic_try (simple_error "maps of different lengths")
(fun () ->
let lsta' = List.sort compare lsta in
@ -133,7 +133,7 @@ let rec assert_value_eq (a, b: (expression * expression )) : unit result =
let%bind _all = bind_map_list aux lst in
ok ()
)
| E_map _, _ ->
| (E_map _ | E_big_map _), _ ->
simple_fail "comparing map with other stuff"
| E_list lsta, E_list lstb -> (

View File

@ -59,6 +59,7 @@ and expression' =
| E_accessor of (expr * access_path)
(* Data Structures *)
| E_map of (expr * expr) list
| E_big_map of (expr * expr) list
| E_list of expr list
| E_set of expr list
| E_look_up of (expr * expr)

View File

@ -42,6 +42,7 @@ and expression ppf (e:expression) : unit =
| E_tuple lst -> fprintf ppf "tuple[@; @[<v>%a@]@;]" (list_sep annotated_expression (tag ",@;")) lst
| E_record m -> fprintf ppf "record[%a]" (smap_sep_d annotated_expression) m
| E_map m -> fprintf ppf "map[@; @[<v>%a@]@;]" (list_sep assoc_annotated_expression (tag ",@;")) m
| E_big_map m -> fprintf ppf "big_map[@; @[<v>%a@]@;]" (list_sep assoc_annotated_expression (tag ",@;")) m
| E_list m -> fprintf ppf "list[@; @[<v>%a@]@;]" (list_sep annotated_expression (tag ",@;")) m
| E_set m -> fprintf ppf "set[@; @[<v>%a@]@;]" (list_sep annotated_expression (tag ",@;")) m
| E_look_up (ds, i) -> fprintf ppf "(%a)[%a]" annotated_expression ds annotated_expression i

View File

@ -41,6 +41,7 @@ let ez_t_record lst ?s () : type_value =
t_record m ?s ()
let t_map key value ?s () = make_t (T_constant ("map", [key ; value])) s
let t_big_map key value ?s () = make_t (T_constant ("big_map", [key ; value])) s
let t_sum m ?s () : type_value = make_t (T_sum m) s
let make_t_ez_sum (lst:(string * type_value) list) : type_value =

View File

@ -156,7 +156,7 @@ module Free_variables = struct
| E_tuple_accessor (a, _) -> self a
| E_list lst -> unions @@ List.map self lst
| E_set lst -> unions @@ List.map self lst
| E_map m -> unions @@ List.map self @@ List.concat @@ List.map (fun (a, b) -> [ a ; b ]) m
| (E_map m | E_big_map m) -> unions @@ List.map self @@ List.concat @@ List.map (fun (a, b) -> [ a ; b ]) m
| E_look_up (a , b) -> unions @@ List.map self [ a ; b ]
| E_matching (a , cs) -> union (self a) (matching_expression b cs)
| E_failwith a -> self a
@ -422,7 +422,7 @@ let rec assert_value_eq (a, b: (value*value)) : unit result =
| E_record _, _ ->
fail @@ (different_values_because_different_types "record vs. non-record" a b)
| E_map lsta, E_map lstb -> (
| (E_map lsta, E_map lstb | E_big_map lsta, E_big_map lstb) -> (
let%bind lst = generic_try (different_size_values "maps of different lengths" a b)
(fun () ->
let lsta' = List.sort compare lsta in
@ -435,7 +435,7 @@ let rec assert_value_eq (a, b: (value*value)) : unit result =
let%bind _all = bind_map_list aux lst in
ok ()
)
| E_map _, _ ->
| (E_map _ | E_big_map _), _ ->
fail @@ different_values_because_different_types "map vs. non-map" a b
| E_list lsta, E_list lstb -> (

View File

@ -80,7 +80,7 @@ module Captured_variables = struct
| E_set lst ->
let%bind lst' = bind_map_list self lst in
ok @@ unions lst'
| E_map m ->
| (E_map m | E_big_map m) ->
let%bind lst' = bind_map_list self @@ List.concat @@ List.map (fun (a, b) -> [ a ; b ]) m in
ok @@ unions lst'
| E_look_up (a , b) ->

View File

@ -99,6 +99,7 @@ and expression =
| E_record_accessor of (ae * string)
(* Data Structures *)
| E_map of (ae * ae) list
| E_big_map of (ae * ae) list
| E_list of ae list
| E_set of ae list
| E_look_up of (ae * ae)

View File

@ -397,7 +397,7 @@ let big_map () : unit result =
let ez lst =
let open Ast_simplified.Combinators in
let lst' = List.map (fun (x, y) -> e_int x, e_int y) lst in
e_pair (e_typed_map lst' t_int t_int) (e_unit ())
e_pair (e_typed_big_map lst' t_int t_int) (e_unit ())
in
let%bind () =
let make_input = fun n -> ez [(23, n) ; (42, 4)] in

View File

@ -434,7 +434,7 @@ and translate_annotated_expression (ae:AST.annotated_expression) : expression re
let%bind (init : expression) = return @@ E_make_empty_set t in
bind_fold_list aux init lst'
)
| E_map m -> (
| (E_map m | E_big_map m) -> (
let%bind (src, dst) =
trace_strong (corner_case ~loc:__LOC__ "not a map") @@
Mini_c.Combinators.get_t_map tv in
@ -802,6 +802,18 @@ let rec untranspile (v : value) (t : AST.type_value) : AST.annotated_expression
bind_map_list aux lst in
return (E_map lst')
)
| T_constant ("big_map", [k_ty;v_ty]) -> (
let%bind lst =
trace_strong (wrong_mini_c_value "map" v) @@
get_map v in
let%bind lst' =
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 lst in
return (E_big_map lst')
)
| T_constant ("list", [ty]) -> (
let%bind lst =
trace_strong (wrong_mini_c_value "list" v) @@

View File

@ -556,6 +556,36 @@ and type_expression : environment -> ?tv_opt:O.type_value -> I.expression -> O.a
ok (t_map key_type value_type ())
in
return (E_map lst') tv
| E_big_map lst ->
let%bind lst' = bind_map_list (bind_map_pair (type_expression e)) lst in
let%bind tv =
let aux opt c =
match opt with
| None -> ok (Some c)
| Some c' ->
let%bind _eq = Ast_typed.assert_type_value_eq (c, c') in
ok (Some c') in
let%bind key_type =
let%bind sub =
bind_fold_list aux None
@@ List.map get_type_annotation
@@ List.map fst lst' in
let%bind annot = bind_map_option get_t_map_key tv_opt in
trace (simple_info "empty map expression without a type annotation") @@
O.merge_annotation annot sub (needs_annotation ae "this map literal")
in
let%bind value_type =
let%bind sub =
bind_fold_list aux None
@@ List.map get_type_annotation
@@ List.map snd lst' in
let%bind annot = bind_map_option get_t_map_value tv_opt in
trace (simple_info "empty map expression without a type annotation") @@
O.merge_annotation annot sub (needs_annotation ae "this map literal")
in
ok (t_big_map key_type value_type ())
in
return (E_big_map lst') tv
| E_lambda {
binder ;
input_type ;
@ -826,6 +856,9 @@ let rec untype_expression (e:O.annotated_expression) : (I.expression) result =
| E_map m ->
let%bind m' = bind_map_list (bind_map_pair untype_expression) m in
return (e_map m')
| E_big_map m ->
let%bind m' = bind_map_list (bind_map_pair untype_expression) m in
return (e_big_map m')
| E_list lst ->
let%bind lst' = bind_map_list untype_expression lst in
return (e_list lst')