diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index 92f8c14aa..18f2d8585 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_deep_set_rm path = let title () = "set removals" in let message () = @@ -795,8 +784,29 @@ 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 = 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 @@ (key', value') + ) + @@ pseq_to_list map_p.map_inj.value.elements in + let expr = + match inj with + | [] -> e_skip ~loc () + | _ :: _ -> + 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 + ) | SetPatch patch -> ( let (setp, loc) = r_split patch in let (name , access_path) = simpl_path setp.path in @@ -808,13 +818,12 @@ 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 ) - | MapRemove r -> ( let (v , loc) = r_split r in let key = v.key in diff --git a/src/test/contracts/map.ligo b/src/test/contracts/map.ligo index 7437cfb26..a022379cd 100644 --- a/src/test/contracts/map.ligo +++ b/src/test/contracts/map.ligo @@ -25,6 +25,17 @@ 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 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)) @@ -60,4 +71,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..829201b23 100644 --- a/src/test/contracts/map.mligo +++ b/src/test/contracts/map.mligo @@ -11,6 +11,15 @@ 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) ] + +(* 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 @@ -34,4 +43,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 38c0869a5..1daf4c046 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -427,6 +427,25 @@ 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 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 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