mr review 2

This commit is contained in:
Pierre-Emmanuel Wulfman 2020-01-10 17:28:45 +01:00
parent 60edd0cf5b
commit 98d6aea4e1
4 changed files with 9 additions and 20 deletions

View File

@ -403,12 +403,14 @@ and translate_expression (expr:expression) (env:environment) : michelson result
] ]
) )
| E_update (record, updates) -> ( | E_update (record, updates) -> (
let%bind record = translate_expression record env in let%bind record' = translate_expression record env in
let insts = [ let insts = [
i_comment "r_update: start, move the record on top # env"; i_comment "r_update: start, move the record on top # env";
record;] in record';] in
let aux (init :t list) (update,expr) = let aux (init :t list) (update,expr) =
let%bind expr' = translate_expression expr env in let record_var = Var.fresh () in
let env' = Environment.add (record_var, record.type_value) env in
let%bind expr' = translate_expression expr env' in
let modify_code = let modify_code =
let aux acc step = match step with let aux acc step = match step with
| `Left -> seq [dip i_unpair ; acc ; i_pair] | `Left -> seq [dip i_unpair ; acc ; i_pair]

View File

@ -473,21 +473,6 @@ let rec assert_value_eq (a, b: (value*value)) : unit result =
| E_record _, _ -> | E_record _, _ ->
fail @@ (different_values_because_different_types "record vs. non-record" a b) fail @@ (different_values_because_different_types "record vs. non-record" a b)
| E_record_update (ra,upa), E_record_update (rb,upb) -> (
let%bind _r = assert_value_eq (ra,rb) in
let%bind lst =
generic_try (simple_error "updates with different number of fields")
(fun () -> List.combine upa upb) in
let aux ((Label a,expra),(Label b, exprb))=
assert (String.equal a b);
assert_value_eq (expra,exprb)
in
let%bind _all = bind_list @@ List.map aux lst in
ok ()
)
| E_record_update _ , _ ->
fail @@ (different_values_because_different_types "record update vs. non record update" a b)
| (E_map lsta, E_map lstb | E_big_map lsta, E_big_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) let%bind lst = generic_try (different_size_values "maps of different lengths" a b)
(fun () -> (fun () ->
@ -524,6 +509,7 @@ let rec assert_value_eq (a, b: (value*value)) : unit result =
fail @@ different_values_because_different_types "set vs. non-set" a b fail @@ different_values_because_different_types "set vs. non-set" a b
| (E_literal _, _) | (E_variable _, _) | (E_application _, _) | (E_literal _, _) | (E_variable _, _) | (E_application _, _)
| (E_lambda _, _) | (E_let_in _, _) | (E_tuple_accessor _, _) | (E_lambda _, _) | (E_let_in _, _) | (E_tuple_accessor _, _)
| (E_record_update _,_)
| (E_record_accessor _, _) | (E_record_accessor _, _)
| (E_look_up _, _) | (E_matching _, _) | (E_look_up _, _) | (E_matching _, _)
| (E_assign _ , _) | (E_assign _ , _)

View File

@ -38,7 +38,8 @@ function modify (const r : foobar) : foobar is
function modify_abc (const r : abc) : abc is function modify_abc (const r : abc) : abc is
block { block {
r := r with record b = 2048; c = 42; end; const c : int = 42;
r := r with record b = 2048; c = c; end;
} with r } with r
type big_record is record type big_record is record

View File

@ -28,7 +28,7 @@ let projection (r : foobar) : int = r.foo + r.bar
let modify (r : foobar) : foobar = {foo = 256; bar = r.bar} let modify (r : foobar) : foobar = {foo = 256; bar = r.bar}
let modify_abc (r : abc) : abc = {r with b = 2048; c = 42} let modify_abc (r : abc) : abc = let c = 42 in {r with b = 2048; c = c}
type big_record = { type big_record = {
a : int ; a : int ;