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

review 3

Browse Source
This commit is contained in:
Pierre-Emmanuel Wulfman 2020-03-12 15:41:26 +01:00
parent c17a749078
commit 660dcbb79f
10 changed files with 50 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1174,7 +1174,7 @@ let%expect_test _ =
let%expect_test _ =
run_ligo_bad [ "compile-contract" ; bad_contract "create_contract_toplevel.mligo" ; "main" ] ;
[%expect {|
ligo: in file "create_contract_toplevel.mligo", line 4, character 35 to line 8, character 8. No free variable allowed in this lambda: variable 'store' {"expression":"CREATE_CONTRACT(lambda (#P:Some(( nat * string ))) : None return let rhs#808 = #P in let p = rhs#808.0 in let s = rhs#808.1 in ( list[] : (TO_list(operation)) , store ) , NONE() : (TO_option(key_hash)) , 300000000mutez , \"un\")","location":"in file \"create_contract_toplevel.mligo\", line 4, character 35 to line 8, character 8"}
ligo: in file "create_contract_toplevel.mligo", line 4, character 35 to line 8, character 8. No free variable allowed in this lambda: variable 'store' {"expression":"CREATE_CONTRACT(lambda (#P:Some(( nat * string ))) : None return let rhs#811 = #P in let p = rhs#811.0 in let s = rhs#811.1 in ( list[] : (TO_list(operation)) , store ) , NONE() : (TO_option(key_hash)) , 300000000mutez , \"un\")","location":"in file \"create_contract_toplevel.mligo\", line 4, character 35 to line 8, character 8"}
If you're not sure how to fix this error, you can
@ -1187,7 +1187,7 @@ ligo: in file "create_contract_toplevel.mligo", line 4, character 35 to line 8,
run_ligo_bad [ "compile-contract" ; bad_contract "create_contract_var.mligo" ; "main" ] ;
[%expect {|
ligo: in file "create_contract_var.mligo", line 6, character 35 to line 10, character 5. No free variable allowed in this lambda: variable 'a' {"expression":"CREATE_CONTRACT(lambda (#P:Some(( nat * int ))) : None return let rhs#811 = #P in let p = rhs#811.0 in let s = rhs#811.1 in ( list[] : (TO_list(operation)) , a ) , NONE() : (TO_option(key_hash)) , 300000000mutez , 1)","location":"in file \"create_contract_var.mligo\", line 6, character 35 to line 10, character 5"}
ligo: in file "create_contract_var.mligo", line 6, character 35 to line 10, character 5. No free variable allowed in this lambda: variable 'a' {"expression":"CREATE_CONTRACT(lambda (#P:Some(( nat * int ))) : None return let rhs#814 = #P in let p = rhs#814.0 in let s = rhs#814.1 in ( list[] : (TO_list(operation)) , a ) , NONE() : (TO_option(key_hash)) , 300000000mutez , 1)","location":"in file \"create_contract_var.mligo\", line 6, character 35 to line 10, character 5"}
If you're not sure how to fix this error, you can

3
src/bin/expect_tests/ligo_interpreter_tests.ml
View File

@ -53,4 +53,5 @@ let%expect_test _ =
val s = { ; 1 : int ; 2 : int ; 3 : int}
val set_add = { ; 0 = ({ ; 1 : int ; 2 : int ; 3 : int}) ; 1 = ({ ; 1 : int ; 2 : int ; 3 : int ; 4 : int}) ; 2 = ({ ; 1 : int}) }
val set_iter_fail = "set_iter_fail" : failure
val set_mem = { ; 0 = (true) ; 1 = (false) ; 2 = (false) } |}] ;
val set_mem = { ; 0 = (true) ; 1 = (false) ; 2 = (false) }
val recursion = 55 : int |}] ;

2
src/bin/expect_tests/typer_error_tests.ml
View File

@ -42,7 +42,7 @@ let%expect_test _ =
run_ligo_bad [ "compile-contract" ; "../../test/contracts/negative/error_no_tail_recursive_function.mligo"; "f"];
[%expect {|
ligo: in file "error_no_tail_recursive_function.mligo", line 2, characters 14-21. Recursive call is only allowed as the last operation: {"function":"unvalid","location":"in file \"error_no_tail_recursive_function.mligo\", line 2, characters 14-21"}
ligo: in file "error_no_tail_recursive_function.mligo", line 2, characters 14-21. Recursion must be achieved through tail-calls only: {"function":"unvalid","location":"in file \"error_no_tail_recursive_function.mligo\", line 2, characters 14-21"}
If you're not sure how to fix this error, you can

11
src/passes/6-interpreter/interpreter.ml
View File

@ -277,10 +277,17 @@ and eval : Ast_typed.expression -> env -> value result
let%bind args' = eval args env in
let f_env' = Env.extend f_env (arg_names, args') in
eval body f_env'
| V_Func_rec (_fun_name,_fun_type,lambda, _env) ->
let%bind args' = eval args env in
let f_env' = Env.extend env (lambda.binder,args') in
eval lambda.result f_env'
| _ -> simple_fail "trying to apply on something that is not a function"
)
| E_lambda { binder; result;} ->
| E_lambda {binder; result;} ->
ok @@ V_Func_val (binder,result,env)
| E_recursive {fun_name; fun_type;lambda} ->
let env' = Env.extend env (fun_name, V_Func_rec(fun_name,fun_type,lambda,env)) in
ok @@ V_Func_rec (fun_name,fun_type,lambda,env')
| E_let_in { let_binder; rhs; let_result; _} ->
let%bind rhs' = eval rhs env in
eval let_result (Env.extend env (let_binder,rhs'))
@ -371,7 +378,7 @@ and eval : Ast_typed.expression -> env -> value result
| _ -> simple_fail "not yet supported case"
(* ((ctor,name),body) *)
)
| E_look_up _ | E_recursive _ ->
| E_look_up _ ->
let serr = Format.asprintf "Unsupported construct :\n %a\n" Ast_typed.PP.expression term in
simple_fail serr

29
src/passes/6-transpiler/transpiler.ml
View File

@ -536,22 +536,23 @@ and transpile_recursive {fun_name; fun_type; lambda} =
let%bind (body,l) = map_lambda fun_name loop_type result in
ok @@ (Expression.make (E_closure {binder;body}) loop_type, binder::l)
| _ ->
let%bind res = replace_callback fun_name loop_type e in
let%bind res = replace_callback fun_name loop_type false e in
ok @@ (res, [])
and replace_callback : AST.expression_variable -> type_value -> AST.expression -> expression result = fun fun_name loop_type e ->
and replace_callback : AST.expression_variable -> type_value -> bool -> AST.expression -> expression result = fun fun_name loop_type shadowed e ->
match e.expression_content with
E_let_in li ->
let%bind let_result = replace_callback fun_name loop_type li.let_result in
E_let_in li ->
let shadowed = shadowed || Var.equal li.let_binder fun_name in
let%bind let_result = replace_callback fun_name loop_type shadowed li.let_result in
let%bind rhs = transpile_annotated_expression li.rhs in
let%bind ty = transpile_type e.type_expression in
ok @@ e_let_in li.let_binder ty li.inline rhs let_result |
E_matching m ->
let%bind ty = transpile_type e.type_expression in
matching fun_name loop_type m ty |
matching fun_name loop_type shadowed m ty |
E_application {expr1;expr2} -> (
match expr1.expression_content with
E_variable name when Var.equal fun_name name ->
match expr1.expression_content,shadowed with
E_variable name, false when Var.equal fun_name name ->
let%bind expr = transpile_annotated_expression expr2 in
ok @@ Expression.make (E_constant {cons_name=C_LOOP_CONTINUE;arguments=[expr]}) loop_type |
_ ->
@ -561,18 +562,18 @@ and transpile_recursive {fun_name; fun_type; lambda} =
_ ->
let%bind expr = transpile_annotated_expression e in
ok @@ Expression.make (E_constant {cons_name=C_LOOP_STOP;arguments=[expr]}) loop_type
and matching : AST.expression_variable -> type_value -> AST.matching -> type_value -> expression result = fun fun_name loop_type m ty ->
and matching : AST.expression_variable -> type_value -> bool -> AST.matching -> type_value -> expression result = fun fun_name loop_type shadowed m ty ->
let return ret = ok @@ Expression.make ret @@ ty in
let%bind expr = transpile_annotated_expression m.matchee in
match m.cases with
Match_bool {match_true; match_false} ->
let%bind (t , f) = bind_map_pair (replace_callback fun_name loop_type) (match_true, match_false) in
let%bind (t , f) = bind_map_pair (replace_callback fun_name loop_type shadowed) (match_true, match_false) in
return @@ E_if_bool (expr, t, f)
| Match_option { match_none; match_some = (name, s, tv) } ->
let%bind n = replace_callback fun_name loop_type match_none in
let%bind n = replace_callback fun_name loop_type shadowed match_none in
let%bind (tv' , s') =
let%bind tv' = transpile_type tv in
let%bind s' = replace_callback fun_name loop_type s in
let%bind s' = replace_callback fun_name loop_type shadowed s in
ok (tv' , s')
in
return @@ E_if_none (expr , n , ((name , tv') , s'))
@ -580,10 +581,10 @@ and transpile_recursive {fun_name; fun_type; lambda} =
match_nil ;
match_cons = ((hd_name) , (tl_name), match_cons, ty) ;
} -> (
let%bind nil = replace_callback fun_name loop_type match_nil in
let%bind nil = replace_callback fun_name loop_type shadowed match_nil in
let%bind cons =
let%bind ty' = transpile_type ty in
let%bind match_cons' = replace_callback fun_name loop_type match_cons in
let%bind match_cons' = replace_callback fun_name loop_type shadowed match_cons in
ok (((hd_name , ty') , (tl_name , ty')) , match_cons')
in
return @@ E_if_cons (expr , nil , cons)
@ -614,7 +615,7 @@ and transpile_recursive {fun_name; fun_type; lambda} =
let%bind ((_ , name) , body) =
trace_option (corner_case ~loc:__LOC__ "missing match clause") @@
List.find_opt (fun ((constructor_name' , _) , _) -> constructor_name' = constructor_name) lst in
let%bind body' = replace_callback fun_name loop_type body in
let%bind body' = replace_callback fun_name loop_type shadowed body in
return @@ E_let_in ((name , tv) , false , top , body')
)
| ((`Node (a , b)) , tv) ->

9
src/passes/8-compiler/compiler_program.ml
View File

@ -59,13 +59,12 @@ let rec get_operator : constant' -> type_value -> expression list -> predicate r
| C_LOOP_CONTINUE -> (
let%bind (_,ty) = get_t_or ty in
let%bind m_ty = Compiler_type.type_ ty in
let m_ty' = t_pair t_unit m_ty in
ok @@ simple_unary @@ prim ~children:[m_ty'] I_LEFT
ok @@ simple_unary @@ prim ~children:[m_ty] I_LEFT
)
| C_LOOP_STOP -> (
let%bind (ty, _) = get_t_or ty in
let%bind m_ty = Compiler_type.type_ ty in
ok @@ simple_unary @@ seq [ i_push_unit; i_pair; prim ~children:[m_ty] I_RIGHT]
ok @@ simple_unary @@ prim ~children:[m_ty] I_RIGHT
)
| C_SET_EMPTY -> (
let%bind ty' = Mini_c.get_t_set ty in
@ -410,12 +409,10 @@ and translate_expression (expr:expression) (env:environment) : michelson result
| C_LOOP_LEFT -> (
let%bind (_, ty) = get_t_or (snd v) in
let%bind m_ty = Compiler_type.type_ ty in
let m_ty' = t_pair t_unit m_ty in
let%bind code = ok (seq [
expr' ;
prim ~children:[m_ty'] I_LEFT;
prim ~children:[m_ty] I_LEFT;
i_loop_left body';
prim I_CDR
]) in
return code
)

3
src/stages/ligo_interpreter/PP.ml
View File

@ -19,6 +19,7 @@ let rec pp_value : value -> string = function
recmap "" in
Format.asprintf "{ %s }" content
| V_Func_val _ -> Format.asprintf "<fun>"
| V_Func_rec _ -> Format.asprintf "<rec fun>"
| V_Construct (name,v) -> Format.asprintf "%s(%s)" name (pp_value v)
| V_List vl ->
Format.asprintf "[%s]" @@
@ -36,4 +37,4 @@ let pp_env : env -> unit = fun env ->
Format.printf "\t%s -> %s\n" (Var.to_name var) (pp_value v))
env in
let () = Format.printf "\n}\n" in
()
()

1
src/stages/ligo_interpreter/types.ml
View File

@ -31,6 +31,7 @@ and constant_val =
and value =
| V_Func_val of (expression_variable * Ast_typed.expression * env)
| V_Func_rec of (expression_variable * Ast_typed.type_expression * Ast_typed.lambda * env)
| V_Ct of constant_val
| V_List of value list
| V_Record of value label_map

7
src/test/contracts/interpret_test.mligo
View File

@ -232,3 +232,10 @@ let set_mem =
Set.mem 1 s,
Set.mem 4 s,
Set.mem 1 (Set.empty : int set)
let recursion =
let rec sum : int*int -> int = fun ((n,res):int*int) ->
let i = 1 in
if (n<1) then res else sum (n-i,res+n)
in
sum (10,0)

8
test.mligo Normal file
View File

@ -0,0 +1,8 @@
let rec fibo2 ((n,n_1,n_0):int*int*int) : int =
let fibo2 : int -> int = fun (k : int) -> k in
if (n < 2) then n_1 else fibo2 3
let main (p,s : unit * int) : operation list * int =
let x : int = fibo2 (5, 1, 1) in
(([] : operation list), x)