From c181ec1cac9a2f5e7e4a2a964b257ebfea15f34c Mon Sep 17 00:00:00 2001 From: John David Pressman Date: Thu, 10 Oct 2019 18:26:28 -0700 Subject: [PATCH 1/7] Upload rough draft of map patch functionality with test Right now I'm concerned that the way this generates the code is inefficient, in particular this line: `in ok @@ (access_path, key', value', loc)` Since the comments [on my code for the set patch](https://gitlab.com/ligolang/ligo/merge_requests/127) warned that repeated generation of the access path is a bad idea(?). In any case this does work, so it's something I can improve on. --- src/passes/2-simplify/pascaligo.ml | 32 ++++++++++++++++++++++++++---- src/test/contracts/map.ligo | 6 +++++- src/test/contracts/map.mligo | 5 ++++- src/test/integration_tests.ml | 5 +++++ 4 files changed, 42 insertions(+), 6 deletions(-) diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index 095ab6ac5..a2c43d0ee 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -119,7 +119,7 @@ module Errors = struct ] in error ~data title message - let unsupported_map_patches patch = + (* let unsupported_map_patches patch = let title () = "map patches" in let message () = Format.asprintf "map patches (a.k.a. functional updates) are \ @@ -128,7 +128,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_set_patches patch = let title () = "set patches" in @@ -817,8 +817,32 @@ and simpl_single_instruction : Raw.single_instr -> (_ -> expression result) resu in return_statement @@ expr ) - | MapPatch patch -> - fail @@ unsupported_map_patches patch + | MapPatch patch -> ( + let (map_p, loc) = r_split patch in + let (name, access_path) = simpl_path map_p.path in + let%bind inj = bind_list + @@ List.map (fun (x:Raw.binding Region.reg) -> + let (x , loc) = r_split x in + let (key, value) = x.source, x.image in + let%bind key' = simpl_expression key in + let%bind value' = simpl_expression value + in ok @@ (access_path, key', value', loc) + ) + @@ pseq_to_list map_p.map_inj.value.elements in + let%bind expr = + let aux = fun (access, key, value, loc) -> + let map = e_variable name in + e_assign ~loc name access (e_map_add key value map) in + let assigns = List.map aux inj 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 + ) + in + return_statement @@ expr + ) | SetPatch patch -> fail @@ unsupported_set_patches patch | MapRemove r -> ( diff --git a/src/test/contracts/map.ligo b/src/test/contracts/map.ligo index 7437cfb26..71be5dc20 100644 --- a/src/test/contracts/map.ligo +++ b/src/test/contracts/map.ligo @@ -25,6 +25,10 @@ function rm (var m : foobar) : foobar is block { remove 42 from map m } with m +function patch_ (var m: foobar) : foobar is block { + patch m with map [0 -> 5; 1 -> 6; 2 -> 7] +} with m + function size_ (const m : foobar) : nat is block {skip} with (size(m)) @@ -60,4 +64,4 @@ var coco : (int*foobar) := (0, m); block { remove 42 from map coco.1 ; coco.1[32] := 16 ; -} with coco.1 \ No newline at end of file +} with coco.1 diff --git a/src/test/contracts/map.mligo b/src/test/contracts/map.mligo index 094252c0e..88089d985 100644 --- a/src/test/contracts/map.mligo +++ b/src/test/contracts/map.mligo @@ -11,6 +11,9 @@ let set_ (n : int) (m : foobar) : foobar = let rm (m : foobar) : foobar = Map.remove 42 m +(* Dummy test so that we can add the same test for PascaLIGO *) +let patch_ (m : foobar) : foobar = Map.literal [ (0, 5) ; (1, 6) ; (2, 7) ] + let size_ (m : foobar) : nat = Map.size m let gf (m : foobar) : int = Map.find 23 m @@ -34,4 +37,4 @@ let deep_op (m : foobar) : foobar = let coco = (0,m) in let coco = (0 , Map.remove 42 coco.(1)) in let coco = (0 , Map.update 32 (Some 16) coco.(1)) in - coco.(1) \ No newline at end of file + coco.(1) diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index 7a50ad29b..7e9f5c3b1 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -411,6 +411,11 @@ let map_ type_f path : unit result = let expected = ez [23, 23] in expect_eq program "rm" input expected in + let%bind () = + let input = ez [(0,0) ; (1,1) ; (2,2)] in + let expected = ez [(0, 5) ; (1, 6) ; (2, 7)] in + expect_eq program "patch_" input expected + in let%bind () = let make_input = fun n -> ez List.(map (fun x -> (x, x)) @@ range n) in let make_expected = e_nat in From 49ffe00466939ca2641b52583a913a128d9c12f8 Mon Sep 17 00:00:00 2001 From: John David Pressman Date: Thu, 10 Oct 2019 18:35:39 -0700 Subject: [PATCH 2/7] Remove unsupported_map_patch error in PascaLIGO simplifier --- src/passes/2-simplify/pascaligo.ml | 11 ----------- 1 file changed, 11 deletions(-) diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index a2c43d0ee..dfa37bd0f 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -119,17 +119,6 @@ module Errors = struct ] in error ~data title message - (* let unsupported_map_patches patch = - let title () = "map patches" in - let message () = - Format.asprintf "map patches (a.k.a. functional updates) are \ - not supported yet" in - let data = [ - ("patch_loc", - fun () -> Format.asprintf "%a" Location.pp_lift @@ patch.Region.region) - ] in - error ~data title message *) - let unsupported_set_patches patch = let title () = "set patches" in let message () = From 62377135c4b1a88c1f351719a4fba254727780f3 Mon Sep 17 00:00:00 2001 From: John David Pressman Date: Fri, 11 Oct 2019 13:23:29 -0700 Subject: [PATCH 3/7] Add empty map patch test --- src/test/contracts/map.ligo | 4 ++++ src/test/contracts/map.mligo | 3 +++ src/test/integration_tests.ml | 5 +++++ 3 files changed, 12 insertions(+) diff --git a/src/test/contracts/map.ligo b/src/test/contracts/map.ligo index 71be5dc20..24a267884 100644 --- a/src/test/contracts/map.ligo +++ b/src/test/contracts/map.ligo @@ -29,6 +29,10 @@ function patch_ (var m: foobar) : foobar is block { patch m with map [0 -> 5; 1 -> 6; 2 -> 7] } with m +function patch_empty (var m : foobar) : foobar is block { + patch m with map [] +} with m + function size_ (const m : foobar) : nat is block {skip} with (size(m)) diff --git a/src/test/contracts/map.mligo b/src/test/contracts/map.mligo index 88089d985..18a84d104 100644 --- a/src/test/contracts/map.mligo +++ b/src/test/contracts/map.mligo @@ -14,6 +14,9 @@ let rm (m : foobar) : foobar = Map.remove 42 m (* Dummy test so that we can add the same test for PascaLIGO *) let patch_ (m : foobar) : foobar = Map.literal [ (0, 5) ; (1, 6) ; (2, 7) ] +(* Second dummy test, see above *) +let patch_empty (m : foobar) : foobar = Map.literal [ (0, 0) ; (1, 1) ; (2, 2) ] + let size_ (m : foobar) : nat = Map.size m let gf (m : foobar) : int = Map.find 23 m diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index 7e9f5c3b1..ad1ce6d69 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -416,6 +416,11 @@ let map_ type_f path : unit result = let expected = ez [(0, 5) ; (1, 6) ; (2, 7)] in expect_eq program "patch_" input expected in + let%bind () = + let input = ez [(0,0) ; (1,1) ; (2,2)] in + let expected = ez [(0,0) ; (1,1) ; (2,2)] in + expect_eq program "patch_empty" input expected + in let%bind () = let make_input = fun n -> ez List.(map (fun x -> (x, x)) @@ range n) in let make_expected = e_nat in From 3d053cd0734abdc813500a7f7c63985f4e0a08c6 Mon Sep 17 00:00:00 2001 From: John David Pressman Date: Fri, 11 Oct 2019 15:44:16 -0700 Subject: [PATCH 4/7] Refactor map patch so that it uses fewer assignments --- src/passes/2-simplify/pascaligo.ml | 31 ++++++++++++++---------------- 1 file changed, 14 insertions(+), 17 deletions(-) diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index dfa37bd0f..b6d6f895d 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -809,28 +809,25 @@ and simpl_single_instruction : Raw.single_instr -> (_ -> expression result) resu | MapPatch patch -> ( let (map_p, loc) = r_split patch in let (name, access_path) = simpl_path map_p.path in - let%bind inj = bind_list - @@ List.map (fun (x:Raw.binding Region.reg) -> - let (x , loc) = r_split x in + let%bind inj = bind_list + @@ List.map (fun (x:Raw.binding Region.reg) -> + let x = x.value in let (key, value) = x.source, x.image in let%bind key' = simpl_expression key in let%bind value' = simpl_expression value - in ok @@ (access_path, key', value', loc) + in ok @@ (key', value') ) @@ pseq_to_list map_p.map_inj.value.elements in - let%bind expr = - let aux = fun (access, key, value, loc) -> - let map = e_variable name in - e_assign ~loc name access (e_map_add key value map) in - let assigns = List.map aux inj 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 - ) - in - return_statement @@ expr + let expr = + match inj with + | [] -> e_skip ~loc () + | _ :: _ -> + let assigns = List.fold_left + (fun map (key, value) -> (e_map_add key value map)) + (e_variable name) + inj + in e_assign ~loc name access_path assigns + in return_statement @@ expr ) | SetPatch patch -> fail @@ unsupported_set_patches patch From 5070ded5b9d241ebb1b78348f1a32f5ff1b3e102 Mon Sep 17 00:00:00 2001 From: John David Pressman Date: Fri, 11 Oct 2019 17:26:28 -0700 Subject: [PATCH 5/7] Add complex path traversal to map patch --- 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 b6d6f895d..337f91abd 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -824,7 +824,7 @@ and simpl_single_instruction : Raw.single_instr -> (_ -> expression result) resu | _ :: _ -> let assigns = List.fold_left (fun map (key, value) -> (e_map_add key value map)) - (e_variable name) + (e_accessor ~loc (e_variable name) access_path) inj in e_assign ~loc name access_path assigns in return_statement @@ expr From 93b5a068b5ece1bfe2759c334a57f26d5b040b9e Mon Sep 17 00:00:00 2001 From: John David Pressman Date: Mon, 14 Oct 2019 10:19:18 -0700 Subject: [PATCH 6/7] Add deep map patch test --- src/test/contracts/map.ligo | 3 +++ src/test/contracts/map.mligo | 3 +++ src/test/integration_tests.ml | 9 +++++++++ 3 files changed, 15 insertions(+) diff --git a/src/test/contracts/map.ligo b/src/test/contracts/map.ligo index 24a267884..a022379cd 100644 --- a/src/test/contracts/map.ligo +++ b/src/test/contracts/map.ligo @@ -33,6 +33,9 @@ function patch_empty (var m : foobar) : foobar is block { patch m with map [] } with m +function patch_deep (var m: foobar * nat) : foobar * nat is + begin patch m.0 with map [1 -> 9]; end with m + function size_ (const m : foobar) : nat is block {skip} with (size(m)) diff --git a/src/test/contracts/map.mligo b/src/test/contracts/map.mligo index 18a84d104..829201b23 100644 --- a/src/test/contracts/map.mligo +++ b/src/test/contracts/map.mligo @@ -17,6 +17,9 @@ let patch_ (m : foobar) : foobar = Map.literal [ (0, 5) ; (1, 6) ; (2, 7) ] (* Second dummy test, see above *) let patch_empty (m : foobar) : foobar = Map.literal [ (0, 0) ; (1, 1) ; (2, 2) ] +(* Third dummy test, see above *) +let patch_deep (m: foobar * nat) : foobar * nat = (Map.literal [ (0, 0) ; (1, 9) ; (2, 2) ], 10p) + let size_ (m : foobar) : nat = Map.size m let gf (m : foobar) : int = Map.find 23 m diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index ad1ce6d69..b964104c9 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -421,6 +421,15 @@ let map_ type_f path : unit result = let expected = ez [(0,0) ; (1,1) ; (2,2)] in expect_eq program "patch_empty" input expected in + let%bind () = + let input = (e_pair + (ez [(0,0) ; (1,1) ; (2,2)]) + (e_nat 10)) in + let expected = (e_pair + (ez [(0,0) ; (1,9) ; (2,2)]) + (e_nat 10)) in + expect_eq program "patch_deep" input expected + in let%bind () = let make_input = fun n -> ez List.(map (fun x -> (x, x)) @@ range n) in let make_expected = e_nat in From ed69c858a8a98f10509b91ae584a288811fe14a5 Mon Sep 17 00:00:00 2001 From: Tom Jack Date: Mon, 14 Oct 2019 14:05:35 -0500 Subject: [PATCH 7/7] Use right folds --- src/passes/2-simplify/pascaligo.ml | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index da0675a4a..18f2d8585 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -800,10 +800,10 @@ and simpl_single_instruction : Raw.single_instr -> (_ -> expression result) resu match inj with | [] -> e_skip ~loc () | _ :: _ -> - let assigns = List.fold_left - (fun map (key, value) -> (e_map_add key value map)) - (e_accessor ~loc (e_variable name) access_path) + let assigns = List.fold_right + (fun (key, value) map -> (e_map_add key value map)) inj + (e_accessor ~loc (e_variable name) access_path) in e_assign ~loc name access_path assigns in return_statement @@ expr ) @@ -818,9 +818,9 @@ and simpl_single_instruction : Raw.single_instr -> (_ -> expression result) resu match inj with | [] -> e_skip ~loc () | _ :: _ -> - let assigns = List.fold_left - (fun s hd -> e_constant "SET_ADD" [hd ; s]) - (e_accessor ~loc (e_variable name) access_path) inj in + let assigns = List.fold_right + (fun hd s -> e_constant "SET_ADD" [hd ; s]) + inj (e_accessor ~loc (e_variable name) access_path) in e_assign ~loc name access_path assigns in return_statement @@ expr )