proper error message for deep accesses in loops of collection body

This commit is contained in:
Lesenechal Remi 2019-10-27 14:09:04 +01:00
parent c7056d200d
commit b71309bfa2

View File

@ -137,6 +137,17 @@ module Errors = struct
] in ] in
error ~data title message error ~data title message
let unsupported_deep_access_for_collection for_col =
let title () = "deep access in loop over collection" in
let message () =
Format.asprintf "currently, we do not support deep \
accesses in loops over collection" in
let data = [
("pattern_loc",
fun () -> Format.asprintf "%a" Location.pp_lift @@ for_col.Region.region)
] in
error ~data title message
(* Logging *) (* Logging *)
let simplifying_instruction t = let simplifying_instruction t =
@ -1013,14 +1024,11 @@ and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun
let replace exp = let replace exp =
(* TODO: map and set updated/remove must also be captured *) (* TODO: map and set updated/remove must also be captured *)
match exp.expression with match exp.expression with
| E_assign ( name , path , expr ) -> (* replace references to fold accumulator as rhs *)
(* replace references to fold accumulator as rhs *) | E_assign ( name , path , expr ) -> ( match path with
let path' = ( match path with | [] -> ok @@ e_assign "_COMPILER_acc" [Access_record name] expr
| [] -> [Access_record name] (* This fails for deep accesses, see LIGO-131 *)
(* This might fail for deep tuple access, see LIGO-131 *) | _ -> fail @@ unsupported_deep_access_for_collection fc.block )
| _ -> ( (Access_record name) :: path )
) in
ok @@ e_assign "_COMPILER_acc" path' expr
| E_variable name -> | E_variable name ->
if (name = fc.var.value ) then if (name = fc.var.value ) then
(* replace references to the collection element *) (* replace references to the collection element *)