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

after review 1

Browse Source
This commit is contained in:
Pierre-Emmanuel Wulfman 2020-01-10 16:41:47 +01:00
parent 812834656a
commit 60edd0cf5b
11 changed files with 92 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/passes/1-parser/cameligo/AST.ml
View File

@ -335,9 +335,11 @@ and field_assign = {
}
and update = {
lbrace : lbrace;
record : path;
kwd_with : kwd_with;
updates : record reg;
rbrace : rbrace;
}
and path =
Name of variable

12
src/passes/1-parser/cameligo/Parser.mly
View File

@ -616,12 +616,18 @@ record_expr:
in {region; value} }
update_record:
"{" path "with" record_expr "}" {
"{" path "with" sep_or_term_list(field_assignment,";") "}" {
let region = cover $1 $5 in
let ne_elements, terminator = $4 in
let value = {
record = $2;
lbrace = $1;
record = $2;
kwd_with = $3;
updates = $4}
updates = { value = {compound = Braces($1,$5);
ne_elements;
terminator};
region = cover $3 $5};
rbrace = $5}
in {region; value} }
field_assignment:

6
src/passes/1-parser/cameligo/ParserLog.ml
View File

@ -176,10 +176,12 @@ and print_projection state {value; _} =
print_nsepseq state "." print_selection field_path
and print_update state {value; _} =
let {record; kwd_with; updates} = value in
let {lbrace; record; kwd_with; updates; rbrace} = value in
print_token state lbrace "{";
print_path state record;
print_token state kwd_with "with";
print_record_expr state updates
print_record_expr state updates;
print_token state rbrace "}"
and print_path state = function
Name var -> print_var state var

3
src/passes/1-parser/cameligo/Tests/pp.mligo
View File

@ -24,3 +24,6 @@ let e = Some (a, B b)
let z = z.1.2
let v = "hello" ^ "world" ^ "!"
let w = Map.literal [(1,"1"); (2,"2")]
let r = { field = 0}
let r = { r with field = 42}

2
src/passes/1-parser/pascaligo/Tests/pp.ligo
View File

@ -24,6 +24,8 @@ function back (var store : store) : list (operation) * store is
x := map [1 -> "1"; 2 -> "2"];
y := a.b.c[3];
a := "hello " ^ "world" ^ "!";
r := record a = 0 end;
r := r with record a = 42 end;
patch store.backers with set [(1); f(2*3)];
remove (1,2,3) from set foo.bar;
remove 3 from map foo.bar;

26
src/passes/4-typer-new/typer.ml
View File

@ -530,14 +530,26 @@ and type_expression : environment -> Solver.state -> ?tv_opt:O.type_value -> I.e
let wrapped = Wrap.record (I.LMap.map get_type_annotation m') in
return_wrapped (E_record m') state' wrapped
| E_update {record; updates} ->
let%bind (record, state') = type_expression e state record in
let aux (acc, state) (k, expr) =
let%bind (expr',state') = type_expression e state expr in
ok ((k,expr')::acc, state')
let%bind (record, state) = type_expression e state record in
let aux (lst,state) (k, expr) =
let%bind (expr', state) = type_expression e state expr in
ok ((k,expr')::lst, state)
in
let%bind(updates,state') = bind_fold_list aux ([], state') updates in
let wrapped = Wrap.list (List.map (fun (_,e) -> get_type_annotation e) updates) in
return_wrapped (E_record_update (record, updates)) state' wrapped
let%bind (updates, state) = bind_fold_list aux ([], state) updates in
let wrapped = get_type_annotation record in
let%bind wrapped = match wrapped.type_value' with
| T_record record ->
let aux (k, e) =
let field_op = I.LMap.find_opt k record in
match field_op with
| None -> failwith @@ Format.asprintf "field %a is not part of record" Stage_common.PP.label k
| Some tv -> O.assert_type_value_eq (tv, get_type_annotation e)
in
let%bind () = bind_iter_list aux updates in
ok (record)
| _ -> failwith "Update an expression which is not a record"
in
return_wrapped (E_record_update (record, updates)) state (Wrap.record wrapped)
(* Data-structure *)
(*

13
src/passes/4-typer-old/typer.ml
View File

@ -504,13 +504,16 @@ and type_expression' : environment -> ?tv_opt:O.type_value -> I.expression -> O.
in
let%bind updates = bind_fold_list aux ([]) updates in
let wrapped = get_type_annotation record in
let wrapped = match wrapped.type_value' with
let%bind () = match wrapped.type_value' with
| T_record record ->
let aux acc (k, e) =
I.LMap.add k (get_type_annotation e) acc
let aux (k, e) =
let field_op = I.LMap.find_opt k record in
match field_op with
| None -> failwith @@ Format.asprintf "field %a is not part of record" Stage_common.PP.label k
| Some tv -> O.assert_type_value_eq (tv, get_type_annotation e)
in
t_record (List.fold_left aux record updates) ()
| _ -> failwith "Update something which is not a record"
bind_iter_list aux updates
| _ -> failwith "Update an expression which is not a record"
in
return (E_record_update (record, updates)) wrapped
(* Data-structure *)

16
src/stages/ast_simplified/misc.ml
View File

@ -99,7 +99,7 @@ let rec assert_value_eq (a, b: (expression * expression )) : unit result =
PP.expression a
PP.expression b
in
fail @@ (fun () -> error (thunk "comparing constant with other stuff") error_content ())
fail @@ (fun () -> error (thunk "comparing constant with other expression") error_content ())
| E_constructor (ca, a), E_constructor (cb, b) when ca = cb -> (
let%bind _eq = assert_value_eq (a, b) in
@ -108,7 +108,7 @@ let rec assert_value_eq (a, b: (expression * expression )) : unit result =
| E_constructor _, E_constructor _ ->
simple_fail "different constructors"
| E_constructor _, _ ->
simple_fail "comparing constructor with other stuff"
simple_fail "comparing constructor with other expression"
| E_tuple lsta, E_tuple lstb -> (
let%bind lst =
@ -118,7 +118,7 @@ let rec assert_value_eq (a, b: (expression * expression )) : unit result =
ok ()
)
| E_tuple _, _ ->
simple_fail "comparing tuple with other stuff"
simple_fail "comparing tuple with other expression"
| E_record sma, E_record smb -> (
let aux _ a b =
@ -130,7 +130,7 @@ let rec assert_value_eq (a, b: (expression * expression )) : unit result =
ok ()
)
| E_record _, _ ->
simple_fail "comparing record with other stuff"
simple_fail "comparing record with other expression"
| E_update ura, E_update urb ->
let%bind lst =
@ -143,7 +143,7 @@ let rec assert_value_eq (a, b: (expression * expression )) : unit result =
let%bind _all = bind_list @@ List.map aux lst in
ok ()
| E_update _, _ ->
simple_fail "comparing record update with orther stuff"
simple_fail "comparing record update with other expression"
| (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")
@ -159,7 +159,7 @@ let rec assert_value_eq (a, b: (expression * expression )) : unit result =
ok ()
)
| (E_map _ | E_big_map _), _ ->
simple_fail "comparing map with other stuff"
simple_fail "comparing map with other expression"
| E_list lsta, E_list lstb -> (
let%bind lst =
@ -169,7 +169,7 @@ let rec assert_value_eq (a, b: (expression * expression )) : unit result =
ok ()
)
| E_list _, _ ->
simple_fail "comparing list with other stuff"
simple_fail "comparing list with other expression"
| E_set lsta, E_set lstb -> (
let lsta' = List.sort (compare) lsta in
@ -181,7 +181,7 @@ let rec assert_value_eq (a, b: (expression * expression )) : unit result =
ok ()
)
| E_set _, _ ->
simple_fail "comparing set with other stuff"
simple_fail "comparing set with other expression"
| (E_ascription (a , _) , _b') -> assert_value_eq (a , b)
| (_a' , E_ascription (b , _)) -> assert_value_eq (a , b)

11
src/test/contracts/record.ligo
View File

@ -38,7 +38,7 @@ function modify (const r : foobar) : foobar is
function modify_abc (const r : abc) : abc is
block {
r := r with record b = 2048; end;
r := r with record b = 2048; c = 42; end;
} with r
type big_record is record
@ -56,3 +56,12 @@ const br : big_record = record
d = 23 ;
e = 23 ;
end
type double_record is record
inner : abc;
end
function modify_inner (const r : double_record) : double_record is
block {
r := r with record inner = r.inner with record b = 2048; end; end;
} with r

8
src/test/contracts/record.mligo
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_abc (r : abc) : abc = {r with {b = 2048}}
let modify_abc (r : abc) : abc = {r with b = 2048; c = 42}
type big_record = {
a : int ;
@ -45,3 +45,9 @@ let br : big_record = {
d = 23 ;
e = 23 ;
}
type double_record = {
inner : abc;
}
let modify_inner (r : double_record) : double_record = {r with inner = {r.inner with b = 2048 }}

22
src/test/integration_tests.ml
View File

@ -682,7 +682,7 @@ let record () : unit result =
let make_expected = fun n -> ez_e_record [
("a" , e_int n) ;
("b" , e_int 2048) ;
("c" , e_int n)
("c" , e_int 42)
] in
expect_eq_n program "modify_abc" make_input make_expected
in
@ -690,6 +690,15 @@ let record () : unit result =
let expected = record_ez_int ["a";"b";"c";"d";"e"] 23 in
expect_eq_evaluate program "br" expected
in
let%bind () =
let make_input = fun n -> ez_e_record [("inner", record_ez_int ["a";"b";"c"] n)] in
let make_expected = fun n -> ez_e_record [("inner", ez_e_record[
("a" , e_int n) ;
("b" , e_int 2048) ;
("c" , e_int n)
])] in
expect_eq_n program "modify_inner" make_input make_expected
in
ok ()
let record_mligo () : unit result =
@ -719,7 +728,7 @@ let record_mligo () : unit result =
let make_expected = fun n -> ez_e_record [
("a" , e_int n) ;
("b" , e_int 2048) ;
("c" , e_int n)
("c" , e_int 42)
] in
expect_eq_n program "modify_abc" make_input make_expected
in
@ -727,6 +736,15 @@ let record_mligo () : unit result =
let expected = record_ez_int ["a";"b";"c";"d";"e"] 23 in
expect_eq_evaluate program "br" expected
in
let%bind () =
let make_input = fun n -> ez_e_record [("inner", record_ez_int ["a";"b";"c"] n)] in
let make_expected = fun n -> ez_e_record [("inner", ez_e_record[
("a" , e_int n) ;
("b" , e_int 2048) ;
("c" , e_int n)
])] in
expect_eq_n program "modify_inner" make_input make_expected
in
ok ()
let tuple () : unit result =