balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

make while_loop, for_int and for_collect more similar

Browse Source
This commit is contained in:
Pierre-Emmanuel Wulfman 2020-02-19 14:18:06 +01:00
parent 9de45285b2
commit eee6dbaeb2
4 changed files with 112 additions and 102 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

115
src/bin/expect_tests/contract_tests.ml
View File

@ -10,10 +10,10 @@ let%expect_test _ =
[%expect {| 1747 bytes |}] ; [%expect {| 1747 bytes |}] ;
run_ligo_good [ "measure-contract" ; contract "multisig.ligo" ; "main" ] ; run_ligo_good [ "measure-contract" ; contract "multisig.ligo" ; "main" ] ;
[%expect {| 1358 bytes |}] ; [%expect {| 1324 bytes |}] ;
run_ligo_good [ "measure-contract" ; contract "multisig-v2.ligo" ; "main" ] ; run_ligo_good [ "measure-contract" ; contract "multisig-v2.ligo" ; "main" ] ;
[%expect {| 3294 bytes |}] ; [%expect {| 3231 bytes |}] ;
run_ligo_good [ "measure-contract" ; contract "vote.mligo" ; "main" ] ; run_ligo_good [ "measure-contract" ; contract "vote.mligo" ; "main" ] ;
[%expect {| 642 bytes |}] ; [%expect {| 642 bytes |}] ;
@ -371,17 +371,16 @@ let%expect_test _ =
SWAP ; SWAP ;
DIP { DROP 2 } } DIP { DROP 2 } }
{ PUSH string "Invalid signature" ; FAILWITH } ; { PUSH string "Invalid signature" ; FAILWITH } ;
DIP { DROP ; DUP } ; DIP 2 { DUP } ;
SWAP ; DIG 2 ;
DIP { DUP } ; DIP { DUP } ;
SWAP ; SWAP ;
DIP { DROP 2 } } DIP { DROP 3 } }
{ DUP } ; { DUP } ;
DIP { DROP } ; DIP 4 { DUP } ;
DIP 3 { DUP } ; DIG 4 ;
DIG 3 ; DIP 4 { DUP } ;
DIP 3 { DUP } ; DIG 4 ;
DIG 3 ;
SWAP ; SWAP ;
CDR ; CDR ;
SWAP ; SWAP ;
@ -389,13 +388,12 @@ let%expect_test _ =
CAR ; CAR ;
DIP { DUP } ; DIP { DUP } ;
PAIR ; PAIR ;
DIP { DROP 3 } } DIP { DROP 4 } }
{ DUP } ; { DUP } ;
DIP { DROP } ;
DIP 4 { DUP } ;
DIG 4 ;
DIP 5 { DUP } ; DIP 5 { DUP } ;
DIG 5 ; DIG 5 ;
DIP 6 { DUP } ;
DIG 6 ;
CAR ; CAR ;
DIP 2 { DUP } ; DIP 2 { DUP } ;
DIG 2 ; DIG 2 ;
@ -423,7 +421,7 @@ let%expect_test _ =
SWAP ; SWAP ;
PAIR ; PAIR ;
CAR ; CAR ;
DIP { DROP 6 } } ; DIP { DROP 7 } } ;
DIP 3 { DUP } ; DIP 3 { DUP } ;
DIG 3 ; DIG 3 ;
DIP { DUP } ; DIP { DUP } ;
@ -450,14 +448,12 @@ let%expect_test _ =
DIP { DUP } ; DIP { DUP } ;
SWAP ; SWAP ;
DIP { DROP 2 } } ; DIP { DROP 2 } } ;
DIP { DROP } ; DIP 3 { DUP } ;
DIP 2 { DUP } ; DIG 3 ;
DIG 2 ;
CAR ; CAR ;
DIP { DUP } ; DIP { DUP } ;
PAIR ; PAIR ;
DIP { DROP 2 } } ; DIP { DROP 3 } } ;
DIP { DROP } ;
DUP ; DUP ;
CAR ; CAR ;
CAR ; CAR ;
@ -465,7 +461,7 @@ let%expect_test _ =
EXEC ; EXEC ;
DIP { DUP ; CDR } ; DIP { DUP ; CDR } ;
PAIR ; PAIR ;
DIP { DROP 6 } } } |} ] DIP { DROP 7 } } } |} ]
let%expect_test _ = let%expect_test _ =
run_ligo_good [ "compile-contract" ; contract "multisig-v2.ligo" ; "main" ] ; run_ligo_good [ "compile-contract" ; contract "multisig-v2.ligo" ; "main" ] ;
@ -589,14 +585,13 @@ let%expect_test _ =
DIP { DUP } ; DIP { DUP } ;
SWAP ; SWAP ;
DIP { DROP 2 } } ; DIP { DROP 2 } } ;
DIP { DROP } ; DIP 3 { DUP } ;
DIP 2 { DUP } ; DIG 3 ;
DIG 2 ;
CAR ; CAR ;
DIP { DUP } ; DIP { DUP } ;
PAIR ; PAIR ;
DIP 2 { DUP } ; DIP 3 { DUP } ;
DIG 2 ; DIG 3 ;
PUSH bool True ; PUSH bool True ;
SENDER ; SENDER ;
UPDATE ; UPDATE ;
@ -604,8 +599,7 @@ let%expect_test _ =
CDR ; CDR ;
SWAP ; SWAP ;
PAIR ; PAIR ;
DIP { DROP 2 } } ; DIP { DROP 3 } } ;
DIP { DROP } ;
DUP ; DUP ;
CAR ; CAR ;
DIP { DUP } ; DIP { DUP } ;
@ -624,11 +618,11 @@ let%expect_test _ =
GT ; GT ;
IF { PUSH string "Maximum number of proposal reached" ; FAILWITH } IF { PUSH string "Maximum number of proposal reached" ; FAILWITH }
{ PUSH unit Unit } ; { PUSH unit Unit } ;
DIP 7 { DUP } ; DIP 8 { DUP } ;
DIG 7 ; DIG 8 ;
DIP { DIP 3 { DUP } ; DIG 3 } ; DIP { DIP 3 { DUP } ; DIG 3 } ;
PAIR ; PAIR ;
DIP { DIP 6 { DUP } ; DIG 6 ; NIL operation ; SWAP ; PAIR } ; DIP { DIP 7 { DUP } ; DIG 7 ; NIL operation ; SWAP ; PAIR } ;
PAIR ; PAIR ;
DIP { DIP 2 { DUP } ; DIG 2 } ; DIP { DIP 2 { DUP } ; DIG 2 } ;
PAIR ; PAIR ;
@ -640,8 +634,8 @@ let%expect_test _ =
GE ; GE ;
IF { DIP 3 { DUP } ; IF { DIP 3 { DUP } ;
DIG 3 ; DIG 3 ;
DIP 8 { DUP } ; DIP 9 { DUP } ;
DIG 8 ; DIG 9 ;
DIP { DIP 4 { DUP } ; DIG 4 ; CAR ; CDR ; CDR ; NONE (set address) } ; DIP { DIP 4 { DUP } ; DIG 4 ; CAR ; CDR ; CDR ; NONE (set address) } ;
UPDATE ; UPDATE ;
DIP { DUP ; CDR ; SWAP ; CAR ; DUP ; CAR ; SWAP ; CDR ; CAR } ; DIP { DUP ; CDR ; SWAP ; CAR ; DUP ; CAR ; SWAP ; CDR ; CAR } ;
@ -654,7 +648,7 @@ let%expect_test _ =
CDR ; CDR ;
CAR ; CAR ;
CDR ; CDR ;
DIP { DIP 9 { DUP } ; DIG 9 } ; DIP { DIP 10 { DUP } ; DIG 10 } ;
EXEC ; EXEC ;
DIP { DUP } ; DIP { DUP } ;
SWAP ; SWAP ;
@ -663,7 +657,7 @@ let%expect_test _ =
CDR ; CDR ;
CAR ; CAR ;
CDR ; CDR ;
DIP { DIP 10 { DUP } ; DIG 10 } ; DIP { DIP 11 { DUP } ; DIG 11 } ;
CONCAT ; CONCAT ;
SHA256 ; SHA256 ;
DIP { DUP ; CAR ; SWAP ; CDR ; DUP ; CDR ; SWAP ; CAR ; CAR } ; DIP { DUP ; CAR ; SWAP ; CDR ; DUP ; CDR ; SWAP ; CAR ; CAR } ;
@ -724,11 +718,10 @@ let%expect_test _ =
PAIR ; PAIR ;
DIP { DROP } } DIP { DROP } }
{ DUP } ; { DUP } ;
DIP { DROP } ;
DIP 4 { DUP } ;
DIG 4 ;
DIP 5 { DUP } ; DIP 5 { DUP } ;
DIG 5 ; DIG 5 ;
DIP 6 { DUP } ;
DIG 6 ;
CAR ; CAR ;
DIP 2 { DUP } ; DIP 2 { DUP } ;
DIG 2 ; DIG 2 ;
@ -736,7 +729,7 @@ let%expect_test _ =
DIP { DROP ; CDR } ; DIP { DROP ; CDR } ;
PAIR ; PAIR ;
CAR ; CAR ;
DIP { DROP 5 } } ; DIP { DROP 6 } } ;
DIP 4 { DUP } ; DIP 4 { DUP } ;
DIG 4 ; DIG 4 ;
DIP 4 { DUP } ; DIP 4 { DUP } ;
@ -764,8 +757,8 @@ let%expect_test _ =
{ DUP ; { DUP ;
DIP 4 { DUP } ; DIP 4 { DUP } ;
DIG 4 ; DIG 4 ;
DIP 9 { DUP } ; DIP 10 { DUP } ;
DIG 9 ; DIG 10 ;
DIP { DIP 6 { DUP } ; DIP { DIP 6 { DUP } ;
DIG 6 ; DIG 6 ;
SOME ; SOME ;
@ -780,14 +773,13 @@ let%expect_test _ =
SWAP ; SWAP ;
CAR ; CAR ;
PAIR } ; PAIR } ;
DIP { DROP } ;
DUP ; DUP ;
CAR ; CAR ;
CDR ; CDR ;
CDR ; CDR ;
DIP { DUP ; CDR } ; DIP { DUP ; CDR } ;
PAIR ; PAIR ;
DIP { DROP 13 } } ; DIP { DROP 15 } } ;
DIP { DROP } } DIP { DROP } }
{ DUP ; { DUP ;
DIP { DIP { DUP } ; SWAP } ; DIP { DIP { DUP } ; SWAP } ;
@ -848,16 +840,15 @@ let%expect_test _ =
SWAP ; SWAP ;
DIP { DROP 2 } } DIP { DROP 2 } }
{ DUP } ; { DUP } ;
DIP { DROP } ;
DUP ; DUP ;
DIP 2 { DUP } ; DIP 3 { DUP } ;
DIG 2 ; DIG 3 ;
DIP { DIP 5 { DUP } ; DIG 5 } ; DIP { DIP 6 { DUP } ; DIG 6 } ;
PAIR ; PAIR ;
DIP { DUP } ; DIP { DUP } ;
PAIR ; PAIR ;
DIP 3 { DUP } ; DIP 4 { DUP } ;
DIG 3 ; DIG 4 ;
SIZE ; SIZE ;
PUSH nat 0 ; PUSH nat 0 ;
SWAP ; SWAP ;
@ -865,8 +856,8 @@ let%expect_test _ =
EQ ; EQ ;
IF { DIP { DUP } ; IF { DIP { DUP } ;
SWAP ; SWAP ;
DIP 7 { DUP } ; DIP 8 { DUP } ;
DIG 7 ; DIG 8 ;
DIP { DIP 2 { DUP } ; DIG 2 ; CAR ; CDR ; CDR ; NONE (set address) } ; DIP { DIP 2 { DUP } ; DIG 2 ; CAR ; CDR ; CDR ; NONE (set address) } ;
UPDATE ; UPDATE ;
DIP { DUP ; CDR ; SWAP ; CAR ; DUP ; CAR ; SWAP ; CDR ; CAR } ; DIP { DUP ; CDR ; SWAP ; CAR ; DUP ; CAR ; SWAP ; CDR ; CAR } ;
@ -884,10 +875,10 @@ let%expect_test _ =
{ DUP ; { DUP ;
DIP 2 { DUP } ; DIP 2 { DUP } ;
DIG 2 ; DIG 2 ;
DIP 8 { DUP } ; DIP 9 { DUP } ;
DIG 8 ; DIG 9 ;
DIP { DIP 5 { DUP } ; DIP { DIP 6 { DUP } ;
DIG 5 ; DIG 6 ;
SOME ; SOME ;
DIP { DIP 3 { DUP } ; DIG 3 ; CAR ; CDR ; CDR } } ; DIP { DIP 3 { DUP } ; DIG 3 ; CAR ; CDR ; CDR } } ;
UPDATE ; UPDATE ;
@ -900,11 +891,10 @@ let%expect_test _ =
SWAP ; SWAP ;
CAR ; CAR ;
PAIR } ; PAIR } ;
DIP { DROP } ; DIP 7 { DUP } ;
DIP 5 { DUP } ; DIG 7 ;
DIG 5 ; DIP 3 { DUP } ;
DIP 2 { DUP } ; DIG 3 ;
DIG 2 ;
SWAP ; SWAP ;
CAR ; CAR ;
PAIR ; PAIR ;
@ -936,13 +926,12 @@ let%expect_test _ =
SWAP ; SWAP ;
CAR ; CAR ;
PAIR ; PAIR ;
DIP { DROP 5 } } ; DIP { DROP 7 } } ;
DIP { DROP } ;
DUP ; DUP ;
CDR ; CDR ;
NIL operation ; NIL operation ;
PAIR ; PAIR ;
DIP { DROP 5 } } ; DIP { DROP 6 } } ;
DIP { DROP 2 } } } |} ] DIP { DROP 2 } } } |} ]
let%expect_test _ = let%expect_test _ =

95
src/passes/2-simplify/pascaligo.ml
View File

@ -14,7 +14,7 @@ let pseq_to_list = function
| Some lst -> npseq_to_list lst | Some lst -> npseq_to_list lst
let get_value : 'a Raw.reg -> 'a = fun x -> x.value let get_value : 'a Raw.reg -> 'a = fun x -> x.value
and repair_mutable_variable (for_body : expression) (element_names : expression_variable list) (env : expression_variable) = and repair_mutable_variable_in_matching (for_body : expression) (element_names : expression_variable list) (env : expression_variable) =
let%bind captured_names = Self_ast_simplified.fold_map_expression let%bind captured_names = Self_ast_simplified.fold_map_expression
(* TODO : these should use Variables sets *) (* TODO : these should use Variables sets *)
(fun (decl_var,free_var : expression_variable list * expression_variable list) (ass_exp : expression) -> (fun (decl_var,free_var : expression_variable list * expression_variable list) (ass_exp : expression) ->
@ -46,7 +46,7 @@ and repair_mutable_variable (for_body : expression) (element_names : expression_
for_body in for_body in
ok @@ captured_names ok @@ captured_names
and repair_mutable_variable_for_collect (for_body : expression) (element_names : expression_variable list) (env : expression_variable) = and repair_mutable_variable_in_loops (for_body : expression) (element_names : expression_variable list) (env : expression_variable) =
let%bind captured_names = Self_ast_simplified.fold_map_expression let%bind captured_names = Self_ast_simplified.fold_map_expression
(* TODO : these should use Variables sets *) (* TODO : these should use Variables sets *)
(fun (decl_var,free_var : expression_variable list * expression_variable list) (ass_exp : expression) -> (fun (decl_var,free_var : expression_variable list * expression_variable list) (ass_exp : expression) ->
@ -89,14 +89,14 @@ and store_mutable_variable (free_vars : expression_variable list) =
let aux var = (Var.to_name var, e_variable var) in let aux var = (Var.to_name var, e_variable var) in
e_record_ez (List.map aux free_vars) e_record_ez (List.map aux free_vars)
and restore_mutable_variable (expr : expression) (free_vars : expression_variable list) (env :expression_variable) = and restore_mutable_variable (expr : expression->expression) (free_vars : expression_variable list) (env :expression_variable) =
let aux (f:expression -> expression) (ev:expression_variable) = let aux (f:expression -> expression) (ev:expression_variable) =
ok @@ fun expr -> f (e_let_in (ev,None) true false (e_accessor (e_variable env) (Var.to_name ev)) expr) ok @@ fun expr -> f (e_let_in (ev,None) true false (e_accessor (e_variable env) (Var.to_name ev)) expr)
in in
let%bind ef = bind_fold_list aux (fun e -> e) free_vars in let%bind ef = bind_fold_list aux (fun e -> e) free_vars in
ok @@ fun expr'_opt -> match expr'_opt with ok @@ fun expr'_opt -> match expr'_opt with
| None -> ok @@ e_let_in (env,None) false false expr (ef (e_skip ())) | None -> ok @@ expr (ef (e_skip ()))
| Some expr' -> ok @@ e_let_in (env,None) false false expr (ef expr') | Some expr' -> ok @@ expr (ef expr')
@ -434,7 +434,7 @@ let rec simpl_expression (t:Raw.expr) : expr result =
let%bind match_false = simpl_expression c.ifnot in let%bind match_false = simpl_expression c.ifnot in
let match_expr = e_matching expr ~loc (Match_bool {match_true; match_false}) in let match_expr = e_matching expr ~loc (Match_bool {match_true; match_false}) in
let env = Var.fresh () in let env = Var.fresh () in
let%bind (_, match_expr) = repair_mutable_variable match_expr [] env in let%bind (_, match_expr) = repair_mutable_variable_in_matching match_expr [] env in
return @@ match_expr return @@ match_expr
| ECase c -> ( | ECase c -> (
@ -451,7 +451,7 @@ let rec simpl_expression (t:Raw.expr) : expr result =
let%bind cases = simpl_cases lst in let%bind cases = simpl_cases lst in
let match_expr = e_matching ~loc e cases in let match_expr = e_matching ~loc e cases in
let env = Var.fresh () in let env = Var.fresh () in
let%bind (_, match_expr) = repair_mutable_variable match_expr [] env in let%bind (_, match_expr) = repair_mutable_variable_in_matching match_expr [] env in
return @@ match_expr return @@ match_expr
) )
| EMap (MapInj mi) -> ( | EMap (MapInj mi) -> (
@ -892,12 +892,16 @@ and simpl_single_instruction : Raw.instruction -> (_ -> expression result) resul
let%bind match_true = match_true @@ Some (e_variable env) in let%bind match_true = match_true @@ Some (e_variable env) in
let%bind match_false = match_false @@ Some (e_variable env) in let%bind match_false = match_false @@ Some (e_variable env) in
let%bind ((_,free_vars_true), match_true) = repair_mutable_variable match_true [] env in let%bind ((_,free_vars_true), match_true) = repair_mutable_variable_in_matching match_true [] env in
let%bind ((_,free_vars_false), match_false) = repair_mutable_variable match_false [] env in let%bind ((_,free_vars_false), match_false) = repair_mutable_variable_in_matching match_false [] env in
let free_vars = free_vars_true @ free_vars_false in let free_vars = free_vars_true @ free_vars_false in
if (List.length free_vars != 0) then if (List.length free_vars != 0) then
let match_expr = e_matching expr ~loc (Match_bool {match_true; match_false}) in let match_expr = e_matching expr ~loc (Match_bool {match_true; match_false}) in
let return_expr = e_let_in (env,None) false false (store_mutable_variable free_vars) match_expr in let return_expr = fun expr ->
e_let_in (env,None) false false (store_mutable_variable free_vars) @@
e_let_in (env,None) false false match_expr @@
expr
in
restore_mutable_variable return_expr free_vars env restore_mutable_variable return_expr free_vars env
else else
return_statement @@ e_matching expr ~loc (Match_bool {match_true=match_true'; match_false=match_false'}) return_statement @@ e_matching expr ~loc (Match_bool {match_true=match_true'; match_false=match_false'})
@ -945,7 +949,7 @@ and simpl_single_instruction : Raw.instruction -> (_ -> expression result) resul
let%bind case_clause'= case_clause @@ None in let%bind case_clause'= case_clause @@ None in
let%bind case_clause = case_clause @@ Some(e_variable env) in let%bind case_clause = case_clause @@ Some(e_variable env) in
let%bind case_vars = get_case_variables x.value.pattern in let%bind case_vars = get_case_variables x.value.pattern in
let%bind ((_,free_vars), case_clause) = repair_mutable_variable case_clause case_vars env in let%bind ((_,free_vars), case_clause) = repair_mutable_variable_in_matching case_clause case_vars env in
ok (free_vars::fv,(x.value.pattern, case_clause, case_clause')) in ok (free_vars::fv,(x.value.pattern, case_clause, case_clause')) in
bind_fold_map_list aux [] (npseq_to_list c.cases.value) in bind_fold_map_list aux [] (npseq_to_list c.cases.value) in
let free_vars = List.concat fv in let free_vars = List.concat fv in
@ -957,7 +961,11 @@ and simpl_single_instruction : Raw.instruction -> (_ -> expression result) resul
let cases = List.map (fun case -> let (a,b,_) = case in (a,b)) cases in let cases = List.map (fun case -> let (a,b,_) = case in (a,b)) cases in
let%bind m = simpl_cases cases in let%bind m = simpl_cases cases in
let match_expr = e_matching ~loc expr m in let match_expr = e_matching ~loc expr m in
let return_expr = e_let_in (env,None) false false (store_mutable_variable free_vars) match_expr in let return_expr = fun expr ->
e_let_in (env,None) false false (store_mutable_variable free_vars) @@
e_let_in (env,None) false false match_expr @@
expr
in
restore_mutable_variable return_expr free_vars env restore_mutable_variable return_expr free_vars env
) )
) )
@ -1180,26 +1188,32 @@ and simpl_while_loop : Raw.while_loop -> (_ -> expression result) result = fun w
let binder = Var.fresh () in let binder = Var.fresh () in
let%bind cond = simpl_expression wl.cond in let%bind cond = simpl_expression wl.cond in
let%bind for_body = simpl_block wl.block.value in
let ctrl = let ctrl =
(e_variable binder) (e_variable binder)
in in
let%bind for_body = simpl_block wl.block.value in
let%bind for_body = for_body @@ Some( ctrl ) in let%bind for_body = for_body @@ Some( ctrl ) in
let%bind ((_,captured_name_list),for_body) = repair_mutable_variable for_body [] binder in let%bind ((_,captured_name_list),for_body) = repair_mutable_variable_in_loops for_body [] binder in
let aux name expr= let aux name expr=
e_let_in (name,None) false false (e_accessor (e_variable binder) (Var.to_name name)) expr e_let_in (name,None) false false (e_accessor (e_accessor (e_variable binder) "0") (Var.to_name name)) expr
in in
let init_rec = store_mutable_variable @@ captured_name_list in let init_rec = e_tuple [store_mutable_variable @@ captured_name_list] in
let restore = fun expr -> List.fold_right aux captured_name_list expr in let restore = fun expr -> List.fold_right aux captured_name_list expr in
let continue_expr = e_constant C_CONTINUE [for_body] in let continue_expr = e_constant C_CONTINUE [for_body] in
let stop_expr = e_constant C_STOP [e_variable binder] in let stop_expr = e_constant C_STOP [e_variable binder] in
let aux_func = e_cond cond continue_expr (stop_expr) in let aux_func =
let aux_func = (restore (aux_func)) in e_lambda binder None None @@
let aux_func = e_lambda binder None None @@ aux_func in restore @@
e_cond cond continue_expr stop_expr in
let loop = e_constant C_FOLD_WHILE [aux_func; e_variable env_rec] in let loop = e_constant C_FOLD_WHILE [aux_func; e_variable env_rec] in
let return_expr = e_let_in (env_rec,None) false false init_rec (loop) in let return_expr = fun expr ->
e_let_in (env_rec,None) false false init_rec @@
e_let_in (env_rec,None) false false loop @@
e_let_in (env_rec,None) false false (e_accessor (e_variable env_rec) "0") @@
expr
in
restore_mutable_variable return_expr captured_name_list env_rec restore_mutable_variable return_expr captured_name_list env_rec
@ -1216,37 +1230,42 @@ and simpl_for_int : Raw.for_int -> (_ -> expression result) result = fun fi ->
let step = e_int 1 in let step = e_int 1 in
let ctrl = let ctrl =
e_let_in (it,Some t_int) false false (e_constant C_ADD [ var ; step ]) e_let_in (it,Some t_int) false false (e_constant C_ADD [ var ; step ])
(e_let_in (binder, None) false false (e_update (e_variable binder) name var) (e_let_in (binder, None) false false (e_update (e_variable binder) "1" var)
(e_variable binder)) (e_variable binder))
in in
(* Modify the body loop*) (* Modify the body loop*)
let%bind for_body = simpl_block fi.block.value in let%bind for_body = simpl_block fi.block.value in
let%bind for_body = for_body @@ Some( ctrl ) in let%bind for_body = for_body @@ Some ctrl in
let%bind ((_,captured_name_list),for_body) = repair_mutable_variable for_body [it] binder in let%bind ((_,captured_name_list),for_body) = repair_mutable_variable_in_loops for_body [it] binder in
let aux name expr= let aux name expr=
e_let_in (name,None) false false (e_accessor (e_variable binder) (Var.to_name name)) expr e_let_in (name,None) false false (e_accessor (e_accessor (e_variable binder) "0") (Var.to_name name)) expr
in in
(* restores the initial value of the free_var*) (* restores the initial value of the free_var*)
let restore = fun expr -> List.fold_right aux captured_name_list expr in let restore = fun expr -> List.fold_right aux captured_name_list expr in
(*Prep the lambda for the fold*) (*Prep the lambda for the fold*)
let continue_expr = e_constant C_CONTINUE [for_body] in let continue_expr = e_constant C_CONTINUE [restore(for_body)] in
let stop_expr = e_constant C_STOP [e_variable binder] in let stop_expr = e_constant C_STOP [e_variable binder] in
let aux_func = e_cond cond continue_expr (stop_expr) in let aux_func = e_lambda binder None None @@
let aux_func = e_let_in (it,Some t_int) false false (e_accessor (e_variable binder) name) (restore (aux_func)) in e_let_in (it,Some t_int) false false (e_accessor (e_variable binder) "1") @@
let aux_func = e_lambda binder None None @@ aux_func in e_cond cond continue_expr (stop_expr) in
(* Make the fold_while en precharge the vakye *) (* Make the fold_while en precharge the vakye *)
let loop = e_constant C_FOLD_WHILE [aux_func; e_variable env_rec] in let loop = e_constant C_FOLD_WHILE [aux_func; e_variable env_rec] in
let init_rec = store_mutable_variable @@ it::captured_name_list in let init_rec = e_pair (store_mutable_variable @@ captured_name_list) var in
let return_expr = e_let_in (env_rec,None) false false init_rec (loop) in
let return_expr = e_let_in (it, Some t_int) false false value @@ return_expr in let return_expr = fun expr ->
e_let_in (it, Some t_int) false false value @@
e_let_in (env_rec,None) false false init_rec @@
e_let_in (env_rec,None) false false loop @@
e_let_in (env_rec,None) false false (e_accessor (e_variable env_rec) "0") @@
expr
in
restore_mutable_variable return_expr captured_name_list env_rec restore_mutable_variable return_expr captured_name_list env_rec
and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun fc -> and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun fc ->
let _elt_name = fc.var.value in
let binder = Var.of_name "arguments" in let binder = Var.of_name "arguments" in
let%bind element_names = ok @@ match fc.bind_to with let%bind element_names = ok @@ match fc.bind_to with
| Some v -> [Var.of_name fc.var.value;Var.of_name (snd v).value] | Some v -> [Var.of_name fc.var.value;Var.of_name (snd v).value]
@ -1254,9 +1273,8 @@ and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun
let env = Var.fresh () in let env = Var.fresh () in
let%bind for_body = simpl_block fc.block.value in let%bind for_body = simpl_block fc.block.value in
let%bind _for_body' = for_body None in
let%bind for_body = for_body @@ Some (e_accessor (e_variable binder) "0") in let%bind for_body = for_body @@ Some (e_accessor (e_variable binder) "0") in
let%bind ((_,free_vars), for_body) = repair_mutable_variable_for_collect for_body element_names binder in let%bind ((_,free_vars), for_body) = repair_mutable_variable_in_loops for_body element_names binder in
let init_record = store_mutable_variable free_vars in let init_record = store_mutable_variable free_vars in
let%bind collect = simpl_expression fc.expr in let%bind collect = simpl_expression fc.expr in
@ -1275,7 +1293,10 @@ and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun
let lambda = e_lambda binder None None (restore for_body) in let lambda = e_lambda binder None None (restore for_body) in
let op_name = match fc.collection with let op_name = match fc.collection with
| Map _ -> C_MAP_FOLD | Set _ -> C_SET_FOLD | List _ -> C_LIST_FOLD in | Map _ -> C_MAP_FOLD | Set _ -> C_SET_FOLD | List _ -> C_LIST_FOLD in
let fold = e_constant op_name [lambda; collect ; init_record] in let fold = fun expr ->
e_let_in (env,None) false false (e_constant op_name [lambda; collect ; init_record]) @@
expr
in
restore_mutable_variable fold free_vars env restore_mutable_variable fold free_vars env
and simpl_declaration_list declarations : and simpl_declaration_list declarations :

2
src/stages/common/PP.ml
View File

@ -235,7 +235,7 @@ module Ast_PP_type (PARAMETER : AST_PARAMETER_TYPE) = struct
| TC_key_hash -> | TC_key_hash ->
"key_hash" "key_hash"
| TC_signature -> | TC_signature ->
"signatuer" "signature"
| TC_timestamp -> | TC_timestamp ->
"timestamp" "timestamp"
| TC_chain_id -> | TC_chain_id ->

2
src/stages/mini_c/PP.ml
View File

@ -44,7 +44,7 @@ and type_constant ppf (tc:type_constant) : unit =
| TC_address -> "address" | TC_address -> "address"
| TC_key -> "key" | TC_key -> "key"
| TC_key_hash -> "key_hash" | TC_key_hash -> "key_hash"
| TC_signature -> "signatuer" | TC_signature -> "signature"
| TC_timestamp -> "timestamp" | TC_timestamp -> "timestamp"
| TC_chain_id -> "chain_id" | TC_chain_id -> "chain_id"
| TC_void -> "void" | TC_void -> "void"