From 2f60c85aa882411811a7085c608c405f8237e747 Mon Sep 17 00:00:00 2001 From: John David Pressman Date: Wed, 9 Oct 2019 17:08:58 -0700 Subject: [PATCH 1/8] Add rough draft of set patch functionality --- src/passes/2-simplify/pascaligo.ml | 40 ++++++++++++++++++------------ 1 file changed, 24 insertions(+), 16 deletions(-) diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index 9dc303e3c..0a0e252d5 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -141,7 +141,7 @@ module Errors = struct ] in error ~data title message - let unsupported_set_patches patch = + (* let unsupported_set_patches patch = let title () = "set patches" in let message () = Format.asprintf "set patches (a.k.a. functional updates) are \ @@ -150,7 +150,7 @@ module Errors = struct ("patch_loc", fun () -> Format.asprintf "%a" Location.pp_lift @@ patch.Region.region) ] in - error ~data title message + error ~data title message *) let unsupported_deep_map_rm path = let title () = "binding removals" in @@ -163,18 +163,6 @@ module Errors = struct ] in error ~data title message - - (* let unsupported_set_removal remove = - let title () = "set removals" in - let message () = - Format.asprintf "removal of elements in a set is not \ - supported yet" in - let data = [ - ("removal_loc", - fun () -> Format.asprintf "%a" Location.pp_lift @@ remove.Region.region) - ] in - error ~data title message *) - let unsupported_deep_set_rm path = let title () = "set removals" in let message () = @@ -839,8 +827,28 @@ and simpl_single_instruction : Raw.single_instr -> (_ -> expression result) resu ) | MapPatch patch -> fail @@ unsupported_map_patches patch - | SetPatch patch -> - fail @@ unsupported_set_patches patch + | SetPatch patch -> ( + let setp = patch.value in + let (name , access_path) = simpl_path setp.path in + let%bind inj = bind_list + @@ List.map (fun (x:Raw.expr) -> + let%bind e = simpl_expression x + in ok e) + @@ pseq_to_list setp.set_inj.value.elements in + let%bind expr = + let aux = fun (v) -> + e_assign name access_path (e_constant "SET_ADD" [v ; e_variable name]) in + let assigns = List.map aux inj in + match assigns with + | [] -> fail @@ unsupported_empty_record_patch setp.set_inj + | hd :: tl -> ( + let aux acc cur = e_sequence acc cur in + ok @@ List.fold_left aux hd tl + ) + in + return_statement @@ expr + ) + | MapRemove r -> ( let (v , loc) = r_split r in let key = v.key in From c82076281fdacbe1f78a6a725374782d98ab348c Mon Sep 17 00:00:00 2001 From: John David Pressman Date: Wed, 9 Oct 2019 23:13:25 -0700 Subject: [PATCH 2/8] Add test for set patch functionality Resolves LIGO-127 --- src/test/contracts/set_arithmetic.ligo | 5 +++++ src/test/integration_tests.ml | 4 ++++ 2 files changed, 9 insertions(+) diff --git a/src/test/contracts/set_arithmetic.ligo b/src/test/contracts/set_arithmetic.ligo index 81f9b0d6c..d1b12195f 100644 --- a/src/test/contracts/set_arithmetic.ligo +++ b/src/test/contracts/set_arithmetic.ligo @@ -17,6 +17,11 @@ function remove_op (const s : set(string)) : set(string) is function remove_syntax (var s : set(string)) : set(string) is begin remove "foobar" from set s; end with s +function patch_op (var s: set(string)) : set(string) is + begin patch s with set ["foobar"]; end with s + function mem_op (const s : set(string)) : bool is begin skip end with set_mem("foobar" , s) + + diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index e68e32d8f..3f9c64ced 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -245,6 +245,10 @@ let set_arithmetic () : unit result = expect_eq program "remove_syntax" (e_set [e_string "foo" ; e_string "bar" ; e_string "foobar"]) (e_set [e_string "foo" ; e_string "bar"]) in + let%bind () = + expect_eq program "patch_op" + (e_set [e_string "foo" ; e_string "bar"]) + (e_set [e_string "foo" ; e_string "bar"; e_string "foobar"]) in let%bind () = expect_eq program "mem_op" (e_set [e_string "foo" ; e_string "bar" ; e_string "foobar"]) From 0de17f4b57e6f7ce180b13119ddcbd03967c8590 Mon Sep 17 00:00:00 2001 From: John David Pressman Date: Thu, 10 Oct 2019 13:35:38 -0700 Subject: [PATCH 3/8] Add empty set patches, add test for empty set patches --- src/passes/2-simplify/pascaligo.ml | 4 ++-- src/test/contracts/set_arithmetic.ligo | 3 +++ src/test/integration_tests.ml | 4 ++++ 3 files changed, 9 insertions(+), 2 deletions(-) diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index 0a0e252d5..bc29a71d9 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -828,7 +828,7 @@ and simpl_single_instruction : Raw.single_instr -> (_ -> expression result) resu | MapPatch patch -> fail @@ unsupported_map_patches patch | SetPatch patch -> ( - let setp = patch.value in + let (setp, loc) = r_split patch in let (name , access_path) = simpl_path setp.path in let%bind inj = bind_list @@ List.map (fun (x:Raw.expr) -> @@ -840,7 +840,7 @@ and simpl_single_instruction : Raw.single_instr -> (_ -> expression result) resu e_assign name access_path (e_constant "SET_ADD" [v ; e_variable name]) in let assigns = List.map aux inj in match assigns with - | [] -> fail @@ unsupported_empty_record_patch setp.set_inj + | [] -> ok @@ e_skip ~loc () | hd :: tl -> ( let aux acc cur = e_sequence acc cur in ok @@ List.fold_left aux hd tl diff --git a/src/test/contracts/set_arithmetic.ligo b/src/test/contracts/set_arithmetic.ligo index d1b12195f..1a8e3550f 100644 --- a/src/test/contracts/set_arithmetic.ligo +++ b/src/test/contracts/set_arithmetic.ligo @@ -20,6 +20,9 @@ function remove_syntax (var s : set(string)) : set(string) is function patch_op (var s: set(string)) : set(string) is begin patch s with set ["foobar"]; end with s +function patch_op_empty (var s: set(string)) : set(string) is + begin patch s with set []; end with s + function mem_op (const s : set(string)) : bool is begin skip end with set_mem("foobar" , s) diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index 3f9c64ced..e82a1b6cd 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -249,6 +249,10 @@ let set_arithmetic () : unit result = expect_eq program "patch_op" (e_set [e_string "foo" ; e_string "bar"]) (e_set [e_string "foo" ; e_string "bar"; e_string "foobar"]) in + let%bind () = + expect_eq program "patch_op_empty" + (e_set [e_string "foo" ; e_string "bar"]) + (e_set [e_string "foo" ; e_string "bar"]) in let%bind () = expect_eq program "mem_op" (e_set [e_string "foo" ; e_string "bar" ; e_string "foobar"]) From d947f3b462fe95e74e9f67cbfef0802898e0fb3e Mon Sep 17 00:00:00 2001 From: John David Pressman Date: Fri, 11 Oct 2019 12:38:00 -0700 Subject: [PATCH 4/8] Change set patch to chain calls and only use one assignment --- src/passes/2-simplify/pascaligo.ml | 20 ++++++++++++-------- 1 file changed, 12 insertions(+), 8 deletions(-) diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index 5dda856b1..d8ea7bc5c 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -806,15 +806,19 @@ and simpl_single_instruction : Raw.single_instr -> (_ -> expression result) resu in ok e) @@ pseq_to_list setp.set_inj.value.elements in let%bind expr = - let aux = fun (v) -> - e_assign name access_path (e_constant "SET_ADD" [v ; e_variable name]) in - let assigns = List.map aux inj in + let rec chain_add = fun lst s : expression -> + match lst with + | [] -> s + | hd :: tl -> chain_add tl (e_constant "SET_ADD" [hd ; s]) in + let assigns = + match inj with + | [] -> e_skip ~loc () + | _ :: _ -> chain_add inj (e_variable name) in match assigns with - | [] -> ok @@ e_skip ~loc () - | hd :: tl -> ( - let aux acc cur = e_sequence acc cur in - ok @@ List.fold_left aux hd tl - ) + | {expression = E_skip; _} -> ok @@ e_skip ~loc () + | {expression = E_constant e; location = loc} -> + ok @@ e_assign name access_path {expression = (E_constant e); location = loc} + | _ -> fail @@ corner_case ~loc:__LOC__ "Unexpected expression type" in return_statement @@ expr ) From c5361c57d45a842199268291636b2b36e38c3854 Mon Sep 17 00:00:00 2001 From: Tom Jack Date: Fri, 11 Oct 2019 15:10:08 -0500 Subject: [PATCH 5/8] Simplify a bit --- src/passes/2-simplify/pascaligo.ml | 32 +++++++++++------------------- 1 file changed, 12 insertions(+), 20 deletions(-) diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index d8ea7bc5c..02a0bedf0 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -800,26 +800,18 @@ and simpl_single_instruction : Raw.single_instr -> (_ -> expression result) resu | SetPatch patch -> ( let (setp, loc) = r_split patch in let (name , access_path) = simpl_path setp.path in - let%bind inj = bind_list - @@ List.map (fun (x:Raw.expr) -> - let%bind e = simpl_expression x - in ok e) - @@ pseq_to_list setp.set_inj.value.elements in - let%bind expr = - let rec chain_add = fun lst s : expression -> - match lst with - | [] -> s - | hd :: tl -> chain_add tl (e_constant "SET_ADD" [hd ; s]) in - let assigns = - match inj with - | [] -> e_skip ~loc () - | _ :: _ -> chain_add inj (e_variable name) in - match assigns with - | {expression = E_skip; _} -> ok @@ e_skip ~loc () - | {expression = E_constant e; location = loc} -> - ok @@ e_assign name access_path {expression = (E_constant e); location = loc} - | _ -> fail @@ corner_case ~loc:__LOC__ "Unexpected expression type" - in + let%bind inj = + bind_list @@ + List.map simpl_expression @@ + pseq_to_list setp.set_inj.value.elements in + let expr = + match inj with + | [] -> e_skip ~loc () + | _ :: _ -> + let assigns = List.fold_right + (fun hd s -> e_constant "SET_ADD" [hd ; s]) + inj (e_variable name) in + e_assign ~loc name access_path assigns in return_statement @@ expr ) From b64f82dff7ce4049684af5ac51e0e2cfe98dc31d Mon Sep 17 00:00:00 2001 From: Tom Jack Date: Fri, 11 Oct 2019 15:24:40 -0500 Subject: [PATCH 6/8] Add failing test --- src/test/contracts/set_arithmetic.ligo | 3 +++ src/test/integration_tests.ml | 8 ++++++++ 2 files changed, 11 insertions(+) diff --git a/src/test/contracts/set_arithmetic.ligo b/src/test/contracts/set_arithmetic.ligo index 1a8e3550f..f38c1319f 100644 --- a/src/test/contracts/set_arithmetic.ligo +++ b/src/test/contracts/set_arithmetic.ligo @@ -20,6 +20,9 @@ function remove_syntax (var s : set(string)) : set(string) is function patch_op (var s: set(string)) : set(string) is begin patch s with set ["foobar"]; end with s +function patch_op_deep (var s: set(string)*nat) : set(string)*nat is + begin patch s.0 with set ["foobar"]; end with s + function patch_op_empty (var s: set(string)) : set(string) is begin patch s with set []; end with s diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index 9d2405ead..4ef61ad01 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -249,6 +249,14 @@ let set_arithmetic () : unit result = expect_eq program "patch_op" (e_set [e_string "foo" ; e_string "bar"]) (e_set [e_string "foo" ; e_string "bar"; e_string "foobar"]) in + let%bind () = + expect_eq program "patch_op_deep" + (e_pair + (e_set [e_string "foo" ; e_string "bar"]) + (e_nat 42)) + (e_pair + (e_set [e_string "foo" ; e_string "bar" ; e_string "foobar"]) + (e_nat 42)) in let%bind () = expect_eq program "patch_op_empty" (e_set [e_string "foo" ; e_string "bar"]) From c2a3fd473cfdbec5008e4da2f6ae7509d37ff4f6 Mon Sep 17 00:00:00 2001 From: Tom Jack Date: Fri, 11 Oct 2019 15:27:41 -0500 Subject: [PATCH 7/8] Fix test --- src/passes/2-simplify/pascaligo.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index 02a0bedf0..0674a3caa 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -810,7 +810,7 @@ and simpl_single_instruction : Raw.single_instr -> (_ -> expression result) resu | _ :: _ -> let assigns = List.fold_right (fun hd s -> e_constant "SET_ADD" [hd ; s]) - inj (e_variable name) in + inj (e_accessor ~loc (e_variable name) access_path) in e_assign ~loc name access_path assigns in return_statement @@ expr ) From b304772928da5a4c54f0ad17fa4cf232d1752836 Mon Sep 17 00:00:00 2001 From: John David Pressman Date: Sat, 12 Oct 2019 12:38:05 -0700 Subject: [PATCH 8/8] Change set patch to use left fold --- src/passes/2-simplify/pascaligo.ml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index 0674a3caa..92f8c14aa 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -808,9 +808,9 @@ and simpl_single_instruction : Raw.single_instr -> (_ -> expression result) resu match inj with | [] -> e_skip ~loc () | _ :: _ -> - let assigns = List.fold_right - (fun hd s -> e_constant "SET_ADD" [hd ; s]) - inj (e_accessor ~loc (e_variable name) access_path) in + let assigns = List.fold_left + (fun s hd -> e_constant "SET_ADD" [hd ; s]) + (e_accessor ~loc (e_variable name) access_path) inj in e_assign ~loc name access_path assigns in return_statement @@ expr )