Refactor map patch so that it uses fewer assignments
This commit is contained in:
parent
62377135c4
commit
3d053cd073
@ -809,28 +809,25 @@ and simpl_single_instruction : Raw.single_instr -> (_ -> expression result) resu
|
|||||||
| MapPatch patch -> (
|
| MapPatch patch -> (
|
||||||
let (map_p, loc) = r_split patch in
|
let (map_p, loc) = r_split patch in
|
||||||
let (name, access_path) = simpl_path map_p.path in
|
let (name, access_path) = simpl_path map_p.path in
|
||||||
let%bind inj = bind_list
|
let%bind inj = bind_list
|
||||||
@@ List.map (fun (x:Raw.binding Region.reg) ->
|
@@ List.map (fun (x:Raw.binding Region.reg) ->
|
||||||
let (x , loc) = r_split x in
|
let x = x.value in
|
||||||
let (key, value) = x.source, x.image in
|
let (key, value) = x.source, x.image in
|
||||||
let%bind key' = simpl_expression key in
|
let%bind key' = simpl_expression key in
|
||||||
let%bind value' = simpl_expression value
|
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
|
@@ pseq_to_list map_p.map_inj.value.elements in
|
||||||
let%bind expr =
|
let expr =
|
||||||
let aux = fun (access, key, value, loc) ->
|
match inj with
|
||||||
let map = e_variable name in
|
| [] -> e_skip ~loc ()
|
||||||
e_assign ~loc name access (e_map_add key value map) in
|
| _ :: _ ->
|
||||||
let assigns = List.map aux inj in
|
let assigns = List.fold_left
|
||||||
match assigns with
|
(fun map (key, value) -> (e_map_add key value map))
|
||||||
| [] -> ok @@ e_skip ~loc ()
|
(e_variable name)
|
||||||
| hd :: tl -> (
|
inj
|
||||||
let aux acc cur = e_sequence acc cur in
|
in e_assign ~loc name access_path assigns
|
||||||
ok @@ List.fold_left aux hd tl
|
in return_statement @@ expr
|
||||||
)
|
|
||||||
in
|
|
||||||
return_statement @@ expr
|
|
||||||
)
|
)
|
||||||
| SetPatch patch ->
|
| SetPatch patch ->
|
||||||
fail @@ unsupported_set_patches patch
|
fail @@ unsupported_set_patches patch
|
||||||
|
Loading…
Reference in New Issue
Block a user