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

Merge branch 'for-loop-bugs' into 'dev'

Browse Source 
For loop bugs fixed

See merge request ligolang/ligo!434
This commit is contained in:
Pierre-Emmanuel Wulfman 2020-02-19 15:08:01 +00:00
commit a6fc8a3f6a
8 changed files with 148 additions and 161 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 _ =

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

@ -3,7 +3,6 @@ open Ast_simplified
module Raw = Parser.Pascaligo.AST module Raw = Parser.Pascaligo.AST
module SMap = Map.String module SMap = Map.String
module SSet = Set.Make (String)
module ParserLog = Parser_pascaligo.ParserLog module ParserLog = Parser_pascaligo.ParserLog
open Combinators open Combinators
@ -14,56 +13,8 @@ let pseq_to_list = function
None -> [] None -> []
| 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
let is_compiler_generated name = String.contains (Var.to_name name) '#'
let _detect_local_declarations (for_body : expression) = and repair_mutable_variable_in_matching (for_body : expression) (element_names : expression_variable list) (env : expression_variable) =
let%bind aux = Self_ast_simplified.fold_expression
(fun (nlist, cur_loop : expression_variable list * bool) (ass_exp : expression) ->
if cur_loop then
match ass_exp.expression_content with
| E_let_in {let_binder;mut=false;rhs = _;let_result = _} ->
let (name,_) = let_binder in
ok (name::nlist, cur_loop)
| E_constant {cons_name=C_MAP_FOLD;arguments= _}
| E_constant {cons_name=C_SET_FOLD;arguments= _}
| E_constant {cons_name=C_LIST_FOLD;arguments= _} -> ok @@ (nlist, false)
| _ -> ok (nlist, cur_loop)
else
ok @@ (nlist, cur_loop)
)
([], true)
for_body in
ok @@ fst aux
let _detect_free_variables (for_body : expression) (local_decl_names : expression_variable list) =
let%bind captured_names = Self_ast_simplified.fold_expression
(fun (prev : expression_variable list) (ass_exp : expression) ->
match ass_exp.expression_content with
| E_constant {cons_name=n;arguments=[a;b]}
when n=C_OR || n=C_AND || n=C_LT || n=C_GT ||
n=C_LE || n=C_GE || n=C_EQ || n=C_NEQ -> (
match (a.expression_content,b.expression_content) with
| E_variable na , E_variable nb ->
let ret = [] in
let ret = if not (is_compiler_generated na) then
na::ret else ret in
let ret = if not (is_compiler_generated nb) then
nb::ret else ret in
ok (ret@prev)
| E_variable n , _
| _ , E_variable n ->
if not (is_compiler_generated n) then
ok (n::prev) else ok prev
| _ -> ok prev)
| _ -> ok prev )
[]
for_body in
let captured_names = List.map (fun (s) -> Var.to_name s) captured_names in
let local_decl_names = List.map (fun (s) -> Var.to_name s) local_decl_names in
ok @@ SSet.elements
@@ SSet.diff (SSet.of_list captured_names) (SSet.of_list local_decl_names)
and repair_mutable_variable (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) ->
@ -77,7 +28,7 @@ and repair_mutable_variable (for_body : expression) (element_names : expression_
ok (true,(decl_var, free_var), e_let_in let_binder false false rhs let_result) ok (true,(decl_var, free_var), e_let_in let_binder false false rhs let_result)
else( else(
let free_var = if (List.mem name free_var) then free_var else name::free_var in let free_var = if (List.mem name free_var) then free_var else name::free_var in
let expr = e_let_in (env,None) false false (e_update (e_variable env) (Var.show name) (e_variable name)) let_result in let expr = e_let_in (env,None) false false (e_update (e_variable env) (Var.to_name name) (e_variable name)) let_result in
ok (true,(decl_var, free_var), e_let_in let_binder false false rhs expr) ok (true,(decl_var, free_var), e_let_in let_binder false false rhs expr)
) )
| E_variable name -> | E_variable name ->
@ -95,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) ->
@ -111,7 +62,7 @@ and repair_mutable_variable_for_collect (for_body : expression) (element_names :
let free_var = if (List.mem name free_var) then free_var else name::free_var in let free_var = if (List.mem name free_var) then free_var else name::free_var in
let expr = e_let_in (env,None) false false ( let expr = e_let_in (env,None) false false (
e_update (e_variable env) ("0") e_update (e_variable env) ("0")
(e_update (e_accessor (e_variable env) "0") (Var.show name) (e_variable name)) (e_update (e_accessor (e_variable env) "0") (Var.to_name name) (e_variable name))
) )
let_result in let_result in
ok (true,(decl_var, free_var), e_let_in let_binder false false rhs expr) ok (true,(decl_var, free_var), e_let_in let_binder false false rhs expr)
@ -135,17 +86,17 @@ and store_mutable_variable (free_vars : expression_variable list) =
if (List.length free_vars == 0) then if (List.length free_vars == 0) then
e_unit () e_unit ()
else else
let aux var = (Var.show 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.show 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')
@ -483,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 -> (
@ -500,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) -> (
@ -941,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'})
@ -994,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
@ -1006,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
) )
) )
@ -1229,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
@ -1265,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]
@ -1303,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
@ -1324,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"

20
src/test/contracts/loop_bugs.ligo Normal file
View File

@ -0,0 +1,20 @@
function shadowing_in_body (var nee : unit) : string is block {
var st : string := "";
var list1 : list(string) := list "to"; "to" end;
for x in list list1 block {
const x : string = "ta";
st := st ^ x;
}
} with st
(* should be "tata" *)
function shadowing_assigned_in_body (var nee : unit) : string is block {
var st : string := "";
var list1 : list(string) := list "to"; "to" end;
for x in list list1 block {
st := st ^ x;
var st : string := "ta";
st := st ^ x;
}
} with st
(* should be "toto" ??? *)

12
src/test/integration_tests.ml
View File

@ -2253,6 +2253,17 @@ let no_semicolon_religo () : unit result =
in in
ok () ok ()
let loop_bugs_ligo () : unit result =
let%bind program = type_file "./contracts/loop_bugs.ligo" in
let input = e_unit () in
let%bind () =
let expected = e_string "tata" in
expect_eq program "shadowing_in_body" input expected in
let%bind () =
let expected = e_string "toto" in
expect_eq program "shadowing_assigned_in_body" input expected in
ok ()
let main = test_suite "Integration (End to End)" [ let main = test_suite "Integration (End to End)" [
test "bytes unpack" bytes_unpack ; test "bytes unpack" bytes_unpack ;
test "bytes unpack (mligo)" bytes_unpack_mligo ; test "bytes unpack (mligo)" bytes_unpack_mligo ;
@ -2421,4 +2432,5 @@ let main = test_suite "Integration (End to End)" [
test "tuple type (mligo)" tuple_type_mligo ; test "tuple type (mligo)" tuple_type_mligo ;
test "tuple type (religo)" tuple_type_religo ; test "tuple type (religo)" tuple_type_religo ;
test "no semicolon (religo)" no_semicolon_religo ; test "no semicolon (religo)" no_semicolon_religo ;
test "loop_bugs (ligo)" loop_bugs_ligo ;
] ]

5
vendors/ligo-utils/simple-utils/var.ml vendored
View File

@ -40,11 +40,6 @@ let to_name var =
| None -> var.name | None -> var.name
| Some _ -> raise Tried_to_unfreshen_variable | Some _ -> raise Tried_to_unfreshen_variable
let show v =
match v.counter with
| None -> Format.sprintf "%s" v.name
| Some i -> Format.sprintf "%s#%d" v.name i
let fresh ?name () = let fresh ?name () =
let name = Option.unopt ~default:"" name in let name = Option.unopt ~default:"" name in
let counter = incr global_counter ; Some !global_counter in let counter = incr global_counter ; Some !global_counter in

1
vendors/ligo-utils/simple-utils/var.mli vendored
View File

@ -31,7 +31,6 @@ val of_name : string -> 'a t
(* TODO don't use this, this should not exist. *) (* TODO don't use this, this should not exist. *)
val to_name : 'a t -> string val to_name : 'a t -> string
val show : 'a t -> string
(* Generate a variable, using a counter value from a _global_ (* Generate a variable, using a counter value from a _global_
counter. If the name is not provided, it will be empty. *) counter. If the name is not provided, it will be empty. *)