From 30f2581f8b62cc7e736fd1aa53227c678164aa57 Mon Sep 17 00:00:00 2001 From: Pierre-Emmanuel Wulfman Date: Thu, 23 Apr 2020 17:53:10 +0200 Subject: [PATCH 1/2] done --- .../2-concrete_to_imperative/cameligo.ml | 2 +- .../2-concrete_to_imperative/pascaligo.ml | 4 ++-- .../imperative_to_sugar.ml | 20 +++++++++++++++++-- 3 files changed, 21 insertions(+), 5 deletions(-) diff --git a/src/passes/2-concrete_to_imperative/cameligo.ml b/src/passes/2-concrete_to_imperative/cameligo.ml index a0a8a55bd..c294e5eb8 100644 --- a/src/passes/2-concrete_to_imperative/cameligo.ml +++ b/src/passes/2-concrete_to_imperative/cameligo.ml @@ -649,7 +649,7 @@ let rec compile_expression : let%bind expr = compile_expression c.test in let%bind match_true = compile_expression c.ifso in let%bind match_false = compile_expression c.ifnot in - return @@ e_matching ~loc expr (Match_bool {match_true; match_false}) + return @@ e_cond ~loc expr match_true match_false ) and compile_fun lamb' : expr result = diff --git a/src/passes/2-concrete_to_imperative/pascaligo.ml b/src/passes/2-concrete_to_imperative/pascaligo.ml index 88127fc9c..ec0a7256a 100644 --- a/src/passes/2-concrete_to_imperative/pascaligo.ml +++ b/src/passes/2-concrete_to_imperative/pascaligo.ml @@ -398,7 +398,7 @@ let rec compile_expression (t:Raw.expr) : expr result = let%bind expr = compile_expression c.test in let%bind match_true = compile_expression c.ifso in let%bind match_false = compile_expression c.ifnot in - return @@ e_matching expr ~loc (Match_bool {match_true; match_false}) + return @@ e_cond ~loc expr match_true match_false | ECase c -> ( let (c , loc) = r_split c in @@ -860,7 +860,7 @@ and compile_single_instruction : Raw.instruction -> (_ -> expression result) res let%bind match_true = match_true None in let%bind match_false = match_false None in - return_statement @@ e_matching expr ~loc (Match_bool {match_true; match_false}) + return_statement @@ e_cond ~loc expr match_true match_false ) | Assign a -> ( let (a , loc) = r_split a in diff --git a/src/passes/4-imperative_to_sugar/imperative_to_sugar.ml b/src/passes/4-imperative_to_sugar/imperative_to_sugar.ml index 055f53ed4..359a3bb61 100644 --- a/src/passes/4-imperative_to_sugar/imperative_to_sugar.ml +++ b/src/passes/4-imperative_to_sugar/imperative_to_sugar.ml @@ -52,8 +52,16 @@ let repair_mutable_variable_in_matching (match_body : O.expression) (element_nam | E_constant {cons_name=C_MAP_FOLD;arguments= _} | E_constant {cons_name=C_SET_FOLD;arguments= _} | E_constant {cons_name=C_LIST_FOLD;arguments= _} + | E_cond _ | E_matching _ -> ok @@ (false, (decl_var,free_var),ass_exp) - | _ -> ok (true, (decl_var, free_var),ass_exp) + | E_constant _ + | E_skip + | E_literal _ | E_variable _ + | E_application _ | E_lambda _| E_recursive _ + | E_constructor _ | E_record _| E_record_accessor _|E_record_update _ + | E_ascription _ | E_sequence _ | E_tuple _ | E_tuple_accessor _ | E_tuple_update _ + | E_map _ | E_big_map _ |E_list _ | E_set _ |E_look_up _ + -> ok (true, (decl_var, free_var),ass_exp) ) (element_names,[]) match_body in @@ -88,8 +96,16 @@ and repair_mutable_variable_in_loops (for_body : O.expression) (element_names : | E_constant {cons_name=C_MAP_FOLD;arguments= _} | E_constant {cons_name=C_SET_FOLD;arguments= _} | E_constant {cons_name=C_LIST_FOLD;arguments= _} + | E_cond _ | E_matching _ -> ok @@ (false,(decl_var,free_var),ass_exp) - | _ -> ok (true,(decl_var, free_var),ass_exp) + | E_constant _ + | E_skip + | E_literal _ | E_variable _ + | E_application _ | E_lambda _| E_recursive _ + | E_constructor _ | E_record _| E_record_accessor _|E_record_update _ + | E_ascription _ | E_sequence _ | E_tuple _ | E_tuple_accessor _ | E_tuple_update _ + | E_map _ | E_big_map _ |E_list _ | E_set _ |E_look_up _ + -> ok (true, (decl_var, free_var),ass_exp) ) (element_names,[]) for_body in From 8dfc8a046956f4b99e71e53fee15aba96053a22e Mon Sep 17 00:00:00 2001 From: Pierre-Emmanuel Wulfman Date: Thu, 23 Apr 2020 18:01:07 +0200 Subject: [PATCH 2/2] reorder generated variable in for_each --- src/passes/4-imperative_to_sugar/imperative_to_sugar.ml | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/passes/4-imperative_to_sugar/imperative_to_sugar.ml b/src/passes/4-imperative_to_sugar/imperative_to_sugar.ml index 359a3bb61..99433d272 100644 --- a/src/passes/4-imperative_to_sugar/imperative_to_sugar.ml +++ b/src/passes/4-imperative_to_sugar/imperative_to_sugar.ml @@ -552,13 +552,14 @@ and compile_for I.{binder;start;final;increment;body} = ok @@ restore_mutable_variable return_expr captured_name_list env_rec and compile_for_each I.{binder;collection;collection_type; body} = + let env_rec = Var.fresh () in let args = Var.fresh () in + let%bind element_names = ok @@ match snd binder with | Some v -> [fst binder;v] | None -> [fst binder] in - let env = Var.fresh () in let%bind body = compile_expression body in let%bind ((_,free_vars), body) = repair_mutable_variable_in_loops body element_names args in let for_body = add_to_end body @@ (O.e_record_accessor (O.e_variable args) (Label "0")) in @@ -582,9 +583,9 @@ and compile_for_each I.{binder;collection;collection_type; body} = | Map -> ok @@ O.C_MAP_FOLD | Set -> ok @@ O.C_SET_FOLD | List -> ok @@ O.C_LIST_FOLD in let fold = fun expr -> - O.e_let_in (env,None) false false (O.e_constant op_name [lambda; collect ; init_record]) expr + O.e_let_in (env_rec,None) false false (O.e_constant op_name [lambda; collect ; init_record]) expr in - ok @@ restore_mutable_variable fold free_vars env + ok @@ restore_mutable_variable fold free_vars env_rec let compile_declaration : I.declaration Location.wrap -> _ = fun {wrap_content=declaration;location} ->