fix problems with nested for collection loop

This commit is contained in:
Lesenechal Remi 2019-11-15 15:49:50 +01:00
parent 22ae4c30b1
commit 683bc0a72b
3 changed files with 35 additions and 46 deletions

View File

@ -116,17 +116,6 @@ 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 =
@ -1047,10 +1036,8 @@ and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun
(fun (prev : type_name list) (ass_exp : expression) -> (fun (prev : type_name list) (ass_exp : expression) ->
match ass_exp.expression with match ass_exp.expression with
| E_assign ( name , _ , _ ) -> | E_assign ( name , _ , _ ) ->
if (String.contains name '#') then if (String.contains name '#') then ok prev
ok prev else ok (name::prev)
else
ok (name::prev)
| _ -> ok prev ) | _ -> ok prev )
[] []
for_body in for_body in
@ -1063,12 +1050,13 @@ and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun
match exp.expression with match exp.expression with
(* replace references to fold accumulator as rhs *) (* replace references to fold accumulator as rhs *)
| E_assign ( name , path , expr ) -> ( | E_assign ( name , path , expr ) -> (
match path with let path' = List.filter
| [] -> ok @@ e_assign "#COMPILER#acc" [Access_record name] expr ( fun el ->
(* This fails for deep accesses, see LIGO-131 LIGO-134 *) match el with
| _ -> | Access_record name -> not (String.contains name '#')
(* ok @@ e_assign "#COMPILER#acc" ((Access_record name)::path) expr) *) | _ -> true )
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 (List.mem name captured_name_list) then if (List.mem name captured_name_list) then
(* replace references to fold accumulator as lhs *) (* replace references to fold accumulator as lhs *)
@ -1107,16 +1095,10 @@ and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun
let ( arg_access: Types.access_path -> expression ) = e_accessor (e_variable "arguments") in let ( arg_access: Types.access_path -> expression ) = e_accessor (e_variable "arguments") in
( match fc.collection with ( match fc.collection with
| Map _ -> | Map _ ->
(* let acc = arg_access [Access_tuple 0 ; Access_tuple 0] in
let collec_elt_v = arg_access [Access_tuple 1 ; Access_tuple 0] in
let collec_elt_k = arg_access [Access_tuple 1 ; Access_tuple 1] in *)
(* The above should work, but not yet (see LIGO-131) *)
let temp_kv = arg_access [Access_tuple 1] in
let acc = arg_access [Access_tuple 0 ] in let acc = arg_access [Access_tuple 0 ] in
let collec_elt_v = e_accessor (e_variable "#COMPILER#temp_kv") [Access_tuple 0] in let collec_elt_v = arg_access [Access_tuple 1 ; Access_tuple 0] in
let collec_elt_k = e_accessor (e_variable "#COMPILER#temp_kv") [Access_tuple 1] in let collec_elt_k = arg_access [Access_tuple 1 ; Access_tuple 1] in
e_let_in ("#COMPILER#acc", None) acc @@ e_let_in ("#COMPILER#acc", None) acc @@
e_let_in ("#COMPILER#temp_kv", None) temp_kv @@
e_let_in ("#COMPILER#collec_elt_k", None) collec_elt_v @@ e_let_in ("#COMPILER#collec_elt_k", None) collec_elt_v @@
e_let_in ("#COMPILER#collec_elt_v", None) collec_elt_k (for_body) e_let_in ("#COMPILER#collec_elt_v", None) collec_elt_k (for_body)
| _ -> | _ ->

View File

@ -134,20 +134,26 @@ function for_collection_map_k (var nee : unit) : string is block {
end end
} with st } with st
// function nested_for_collection (var nee : unit) : (int*string) is block { function nested_for_collection (var nee : unit) : (int*string) is block {
// var myint : int := 0; var myint : int := 0;
// var myst : string := ""; var mystoo : string := "";
// var mylist : list(int) := list 1 ; 2 ; 3 end ; var mylist : list(int) := list 1 ; 2 ; 3 end ;
// for i : int in list mylist var mymap : map(string,string) := map " one" -> "," ; "two" -> " " end ;
// begin
// myint := myint + i ; for i in list mylist
// var myset : set(string) := set "1" ; "2" ; "3" end ; begin
// for st : string in set myset myint := myint + i ;
// begin var myset : set(string) := set "1" ; "2" ; "3" end ;
// myst := myst ^ st ; for st in set myset
// end begin
// end mystoo := mystoo ^ st ;
// } with (myint,myst) for k -> v in map mymap
begin
mystoo := mystoo ^ k ^ v ;
end
end
end
} with (myint,mystoo)
function dummy (const n : nat) : nat is block { function dummy (const n : nat) : nat is block {
while False block { skip } while False block { skip }

View File

@ -812,9 +812,10 @@ let loop () : unit result =
let%bind () = let%bind () =
let expected = (e_int 20) in let expected = (e_int 20) in
expect_eq program "for_collection_comp_with_acc" input expected in expect_eq program "for_collection_comp_with_acc" input expected in
(* let%bind () = let%bind () =
let expected = e_pair (e_int 6) (e_string "123123123") in let expected = e_pair (e_int 6)
expect_eq program "nested_for_collection" input expected in *) (e_string "1 one,two 2 one,two 3 one,two 1 one,two 2 one,two 3 one,two 1 one,two 2 one,two 3 one,two ") in
expect_eq program "nested_for_collection" input expected in
let%bind () = let%bind () =
let ez lst = let ez lst =
let open Ast_simplified.Combinators in let open Ast_simplified.Combinators in