From d59cd771c9c590652ea298f7349ba25659aab5ed Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Tue, 8 Oct 2019 16:41:47 +0200 Subject: [PATCH 1/3] fix unsupported deep_map assignements and remove. add tests --- src/passes/2-simplify/pascaligo.ml | 54 +++++++++++------------------- src/test/contracts/map.ligo | 7 ++++ src/test/contracts/map.mligo | 8 ++++- src/test/integration_tests.ml | 5 +++ 4 files changed, 39 insertions(+), 35 deletions(-) diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index 9dc303e3c..6071da798 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -109,17 +109,6 @@ module Errors = struct ] in error ~data title message - let unsupported_deep_map_assign v = - let title () = "map assignments" in - let message () = - Format.asprintf "assignments to embedded maps are not \ - supported yet" in - let data = [ - ("lhs_loc", - fun () -> Format.asprintf "%a" Location.pp_lift @@ v.Region.region) - ] in - error ~data title message - let unsupported_empty_record_patch record_expr = let title () = "empty record patch" in let message () = @@ -152,18 +141,6 @@ module Errors = struct ] in error ~data title message - let unsupported_deep_map_rm path = - let title () = "binding removals" in - let message () = - Format.asprintf "removal of bindings from embedded maps \ - are not supported yet" in - let data = [ - ("path_loc", - fun () -> Format.asprintf "%a" Location.pp_lift @@ path.Region.region) - ] in - error ~data title message - - (* let unsupported_set_removal remove = let title () = "set removals" in let message () = @@ -791,13 +768,17 @@ and simpl_single_instruction : Raw.single_instr -> (_ -> expression result) resu ) | MapPath v -> ( let v' = v.value in - let%bind name = match v'.path with - | Name name -> ok name - | _ -> fail @@ unsupported_deep_map_assign v in + let%bind (varname,map,path) = match v'.path with + | Name name -> ok (name.value , e_variable name.value, []) + | Path p -> + let expr = e_variable p.value.struct_name.value in + let (_,p') = simpl_path v'.path in + let accessor = e_accessor expr p' in + ok @@ (p.value.struct_name.value , accessor , p') + in let%bind key_expr = simpl_expression v'.index.value.inside in - let old_expr = e_variable name.value in - let expr' = e_map_add key_expr value_expr old_expr in - return_statement @@ e_assign ~loc name.value [] expr' + let expr' = e_map_add key_expr value_expr map in + return_statement @@ e_assign ~loc varname path expr' ) ) | CaseInstr c -> ( @@ -844,12 +825,17 @@ and simpl_single_instruction : Raw.single_instr -> (_ -> expression result) resu | MapRemove r -> ( let (v , loc) = r_split r in let key = v.key in - let%bind map = match v.map with - | Name v -> ok v.value - | Path path -> fail @@ unsupported_deep_map_rm path in + let%bind (varname,map,path) = match v.map with + | Name v -> ok (v.value , e_variable v.value , []) + | Path p -> + let expr = e_variable p.value.struct_name.value in + let (_,p') = simpl_path v.map in + let accessor = e_accessor expr p' in + ok @@ (p.value.struct_name.value , accessor , p') + in let%bind key' = simpl_expression key in - let expr = e_constant ~loc "MAP_REMOVE" [key' ; e_variable map] in - return_statement @@ e_assign ~loc map [] expr + let expr = e_constant ~loc "MAP_REMOVE" [key' ; map] in + return_statement @@ e_assign ~loc varname path expr ) | SetRemove r -> ( let (set_rm, loc) = r_split r in diff --git a/src/test/contracts/map.ligo b/src/test/contracts/map.ligo index 7d843f163..7437cfb26 100644 --- a/src/test/contracts/map.ligo +++ b/src/test/contracts/map.ligo @@ -54,3 +54,10 @@ function map_op (const m : foobar) : foobar is function fold_op (const m : foobar) : int is function aggregate (const i : int ; const j : (int * int)) : int is block { skip } with i + j.0 + j.1 ; block { skip } with map_fold(m , 10 , aggregate) + +function deep_op (var m : foobar) : foobar is +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 diff --git a/src/test/contracts/map.mligo b/src/test/contracts/map.mligo index 0d6ec9918..094252c0e 100644 --- a/src/test/contracts/map.mligo +++ b/src/test/contracts/map.mligo @@ -28,4 +28,10 @@ let map_op (m : foobar) : foobar = let fold_op (m : foobar) : foobar = let aggregate = fun (i : int) (j : (int * int)) -> i + j.(0) + j.(1) in - Map.fold m 10 aggregate \ No newline at end of file + Map.fold m 10 aggregate + +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 diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index e68e32d8f..7a50ad29b 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -456,6 +456,11 @@ let map_ type_f path : unit result = let expected = e_int 76 in expect_eq program "fold_op" input expected in + let%bind () = + let input = ez [(2 , 20) ; (42 , 10)] in + let expected = ez [(2 , 20) ; (32 , 16) ] in + expect_eq program "deep_op" input expected + in ok () let big_map_ type_f path : unit result = From 54662db2f63947f337cb4a681ddd7af19f1e7f8d Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Tue, 8 Oct 2019 18:02:43 +0200 Subject: [PATCH 2/3] use simpl_projection to build accessor --- src/passes/2-simplify/pascaligo.ml | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index 6071da798..1b45c8c20 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -771,9 +771,8 @@ and simpl_single_instruction : Raw.single_instr -> (_ -> expression result) resu let%bind (varname,map,path) = match v'.path with | Name name -> ok (name.value , e_variable name.value, []) | Path p -> - let expr = e_variable p.value.struct_name.value in let (_,p') = simpl_path v'.path in - let accessor = e_accessor expr p' in + let%bind accessor = simpl_projection p in ok @@ (p.value.struct_name.value , accessor , p') in let%bind key_expr = simpl_expression v'.index.value.inside in @@ -828,9 +827,8 @@ and simpl_single_instruction : Raw.single_instr -> (_ -> expression result) resu let%bind (varname,map,path) = match v.map with | Name v -> ok (v.value , e_variable v.value , []) | Path p -> - let expr = e_variable p.value.struct_name.value in let (_,p') = simpl_path v.map in - let accessor = e_accessor expr p' in + let%bind accessor = simpl_projection p in ok @@ (p.value.struct_name.value , accessor , p') in let%bind key' = simpl_expression key in From 8c29dc6df3c3dc6d4e3f9bb20c83ad9d1476ecb1 Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Tue, 8 Oct 2019 18:20:32 +0200 Subject: [PATCH 3/3] cleaning (using name return by simpl_path which is equivalent) --- src/passes/2-simplify/pascaligo.ml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index 1b45c8c20..3ef036291 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -771,9 +771,9 @@ and simpl_single_instruction : Raw.single_instr -> (_ -> expression result) resu let%bind (varname,map,path) = match v'.path with | Name name -> ok (name.value , e_variable name.value, []) | Path p -> - let (_,p') = simpl_path v'.path in + let (name,p') = simpl_path v'.path in let%bind accessor = simpl_projection p in - ok @@ (p.value.struct_name.value , accessor , p') + ok @@ (name , accessor , p') in let%bind key_expr = simpl_expression v'.index.value.inside in let expr' = e_map_add key_expr value_expr map in @@ -827,9 +827,9 @@ and simpl_single_instruction : Raw.single_instr -> (_ -> expression result) resu let%bind (varname,map,path) = match v.map with | Name v -> ok (v.value , e_variable v.value , []) | Path p -> - let (_,p') = simpl_path v.map in + let (name,p') = simpl_path v.map in let%bind accessor = simpl_projection p in - ok @@ (p.value.struct_name.value , accessor , p') + ok @@ (name , accessor , p') in let%bind key' = simpl_expression key in let expr = e_constant ~loc "MAP_REMOVE" [key' ; map] in