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.
This commit is contained in:
parent
dfe6f144bb
commit
c181ec1cac
@ -119,7 +119,7 @@ module Errors = struct
|
|||||||
] in
|
] in
|
||||||
error ~data title message
|
error ~data title message
|
||||||
|
|
||||||
let unsupported_map_patches patch =
|
(* let unsupported_map_patches patch =
|
||||||
let title () = "map patches" in
|
let title () = "map patches" in
|
||||||
let message () =
|
let message () =
|
||||||
Format.asprintf "map patches (a.k.a. functional updates) are \
|
Format.asprintf "map patches (a.k.a. functional updates) are \
|
||||||
@ -128,7 +128,7 @@ module Errors = struct
|
|||||||
("patch_loc",
|
("patch_loc",
|
||||||
fun () -> Format.asprintf "%a" Location.pp_lift @@ patch.Region.region)
|
fun () -> Format.asprintf "%a" Location.pp_lift @@ patch.Region.region)
|
||||||
] in
|
] in
|
||||||
error ~data title message
|
error ~data title message *)
|
||||||
|
|
||||||
let unsupported_set_patches patch =
|
let unsupported_set_patches patch =
|
||||||
let title () = "set patches" in
|
let title () = "set patches" in
|
||||||
@ -817,8 +817,32 @@ and simpl_single_instruction : Raw.single_instr -> (_ -> expression result) resu
|
|||||||
in
|
in
|
||||||
return_statement @@ expr
|
return_statement @@ expr
|
||||||
)
|
)
|
||||||
| MapPatch patch ->
|
| MapPatch patch -> (
|
||||||
fail @@ unsupported_map_patches 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 ->
|
| SetPatch patch ->
|
||||||
fail @@ unsupported_set_patches patch
|
fail @@ unsupported_set_patches patch
|
||||||
| MapRemove r -> (
|
| MapRemove r -> (
|
||||||
|
@ -25,6 +25,10 @@ function rm (var m : foobar) : foobar is block {
|
|||||||
remove 42 from map m
|
remove 42 from map m
|
||||||
} with 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
|
function size_ (const m : foobar) : nat is
|
||||||
block {skip} with (size(m))
|
block {skip} with (size(m))
|
||||||
|
|
||||||
@ -60,4 +64,4 @@ var coco : (int*foobar) := (0, m);
|
|||||||
block {
|
block {
|
||||||
remove 42 from map coco.1 ;
|
remove 42 from map coco.1 ;
|
||||||
coco.1[32] := 16 ;
|
coco.1[32] := 16 ;
|
||||||
} with coco.1
|
} with coco.1
|
||||||
|
@ -11,6 +11,9 @@ let set_ (n : int) (m : foobar) : foobar =
|
|||||||
|
|
||||||
let rm (m : foobar) : foobar = Map.remove 42 m
|
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 size_ (m : foobar) : nat = Map.size m
|
||||||
|
|
||||||
let gf (m : foobar) : int = Map.find 23 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,m) in
|
||||||
let coco = (0 , Map.remove 42 coco.(1)) in
|
let coco = (0 , Map.remove 42 coco.(1)) in
|
||||||
let coco = (0 , Map.update 32 (Some 16) coco.(1)) in
|
let coco = (0 , Map.update 32 (Some 16) coco.(1)) in
|
||||||
coco.(1)
|
coco.(1)
|
||||||
|
@ -411,6 +411,11 @@ let map_ type_f path : unit result =
|
|||||||
let expected = ez [23, 23] in
|
let expected = ez [23, 23] in
|
||||||
expect_eq program "rm" input expected
|
expect_eq program "rm" input expected
|
||||||
in
|
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%bind () =
|
||||||
let make_input = fun n -> ez List.(map (fun x -> (x, x)) @@ range n) in
|
let make_input = fun n -> ez List.(map (fun x -> (x, x)) @@ range n) in
|
||||||
let make_expected = e_nat in
|
let make_expected = e_nat in
|
||||||
|
Loading…
Reference in New Issue
Block a user