optim for record

This commit is contained in:
Pierre-Emmanuel Wulfman 2020-03-20 11:54:31 +01:00 committed by Tom Jack
parent d659b32169
commit 79f2df2314

View File

@ -474,14 +474,27 @@ and transpile_annotated_expression (ae:AST.expression) : expression result =
let expr = List.fold_left aux record' path in let expr = List.fold_left aux record' path in
ok expr ok expr
| E_record_update {record; path; update} -> | E_record_update {record; path; update} ->
let%bind ty' = transpile_type (get_type_expression record) in let rec aux res (r,p,up) =
let%bind ty_lmap = let ty = get_type_expression r in
trace_strong (corner_case ~loc:__LOC__ "not a record") @@ let%bind ty_lmap =
get_t_record (get_type_expression record) in trace_strong (corner_case ~loc:__LOC__ "not a record") @@
let%bind ty'_lmap = Ast_typed.Helpers.bind_map_lmap_t transpile_type ty_lmap in get_t_record (ty) in
let%bind path = let%bind ty' = transpile_type (ty) in
trace_strong (corner_case ~loc:__LOC__ "record access") @@ let%bind ty'_lmap = Ast_typed.Helpers.bind_map_lmap_t transpile_type ty_lmap in
record_access_to_lr ty' ty'_lmap path in let%bind p' =
trace_strong (corner_case ~loc:__LOC__ "record access") @@
record_access_to_lr ty' ty'_lmap p in
let res' = res @ p' in
match (up:AST.expression).expression_content with
| AST.E_record_update {record=record'; path=path'; update=update'} -> (
match record.expression_content with
| AST.E_record_accessor {record;path} when record = r && path = p ->
aux res' (record',path',update')
| _ -> ok @@ (up,res')
)
| _ -> ok @@ (up,res')
in
let%bind (update, path) = aux [] (record, path, update) in
let path = List.map snd path in let path = List.map snd path in
let%bind update = transpile_annotated_expression update in let%bind update = transpile_annotated_expression update in
let%bind record = transpile_annotated_expression record in let%bind record = transpile_annotated_expression record in