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

compiling Pascaligo

Browse Source
This commit is contained in:
Pierre-Emmanuel Wulfman 2020-03-07 01:19:22 +01:00
parent e7c71ae4cc
commit b15d9a5123
4 changed files with 67 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
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 : ( nat * string ):Some(( nat * string ))) : None return let rhs#809 = #P in let p = rhs#809.0 in let s = rhs#809.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#810 = #P in let p = rhs#810.0 in let s = rhs#810.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 : ( nat * int ):Some(( nat * int ))) : None return let rhs#812 = #P in let p = rhs#812.0 in let s = rhs#812.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#813 = #P in let p = rhs#813.0 in let s = rhs#813.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
@ -1344,4 +1344,4 @@ let%expect_test _ =
* Visit our documentation: https://ligolang.org/docs/intro/what-and-why/
* Ask a question on our Discord: https://discord.gg/9rhYaEt
* Open a gitlab issue: https://gitlab.com/ligolang/ligo/issues/new
* Check the changelog by running 'ligo changelog' |}]
* Check the changelog by running 'ligo changelog' |}]

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

@ -184,6 +184,17 @@ module Errors = struct
] in
error ~data title message
let _untyped_recursive_function var =
let title () = "" in
let message () =
Format.asprintf "\nUntyped recursive function \
are not supported yet.\n" in
let param_loc = var.Region.region in
let data = [
("location",
fun () -> Format.asprintf "%a" Location.pp_lift @@ param_loc)]
in error ~data title message
(* Logging *)
let simplifying_instruction t =
@ -659,7 +670,7 @@ and simpl_fun_decl :
((expression_variable * type_expression option) * expression) result =
fun ~loc x ->
let open! Raw in
let {fun_name; param; ret_type; block_with;
let {kwd_recursive;fun_name; param; ret_type; block_with;
return; attributes} : fun_decl = x in
let inline =
match attributes with
@ -683,11 +694,17 @@ and simpl_fun_decl :
let%bind result =
let aux prec cur = cur (Some prec) in
bind_fold_right_list aux result body in
let expression : expression = e_lambda ~loc (Var.of_name binder) (Some input_type)
(Some output_type) result in
let type_annotation =
Some (make_t @@ T_arrow {type1=input_type;type2=output_type}) in
ok ((Var.of_name fun_name.value, type_annotation), expression)
let binder = Var.of_name binder in
let fun_name = Var.of_name fun_name.value in
let fun_type = t_function input_type output_type in
let expression : expression =
e_lambda ~loc binder (Some input_type)(Some output_type) result in
let%bind expression = match kwd_recursive with
None -> ok @@ expression |
Some _ -> ok @@ e_recursive ~loc fun_name fun_type
@@ {binder;input_type=Some input_type; output_type= Some output_type; result}
in
ok ((fun_name, Some fun_type), expression)
)
| lst -> (
let lst = npseq_to_list lst in
@ -713,10 +730,16 @@ and simpl_fun_decl :
let%bind result =
let aux prec cur = cur (Some prec) in
bind_fold_right_list aux result body in
let expression =
e_lambda ~loc binder (Some (input_type)) (Some output_type) result in
let type_annotation = Some (make_t @@ T_arrow {type1=input_type; type2=output_type}) in
ok ((Var.of_name fun_name.value, type_annotation), expression)
let fun_name = Var.of_name fun_name.value in
let fun_type = t_function input_type output_type in
let expression : expression =
e_lambda ~loc binder (Some input_type)(Some output_type) result in
let%bind expression = match kwd_recursive with
None -> ok @@ expression |
Some _ -> ok @@ e_recursive ~loc fun_name fun_type
@@ {binder;input_type=Some input_type; output_type= Some output_type; result}
in
ok ((fun_name, Some fun_type), expression)
)
)
@ -724,23 +747,29 @@ and simpl_fun_expression :
loc:_ -> Raw.fun_expr -> (type_expression option * expression) result =
fun ~loc x ->
let open! Raw in
let {param;ret_type;return;_} : fun_expr = x in
let {kwd_recursive;param;ret_type;return} : fun_expr = x in
let statements = [] in
(match param.value.inside with
a, [] -> (
let%bind input = simpl_param a in
let (binder , input_type) = input in
let%bind instructions = simpl_statement_list statements in
let%bind result = simpl_expression return in
let%bind output_type = simpl_type_expression ret_type in
let body = instructions in
let%bind result =
let aux prec cur = cur (Some prec) in
bind_fold_right_list aux result body in
let expression : expression = e_lambda ~loc (Var.of_name binder) (Some input_type)
(Some output_type) result in
let type_annotation = Some (make_t @@ T_arrow {type1=input_type;type2=output_type}) in
ok (type_annotation , expression)
a, [] -> (
let%bind input = simpl_param a in
let (binder , input_type) = input in
let%bind instructions = simpl_statement_list statements in
let%bind result = simpl_expression return in
let%bind output_type = simpl_type_expression ret_type in
let body = instructions in
let%bind result =
let aux prec cur = cur (Some prec) in
bind_fold_right_list aux result body in
let binder = Var.of_name binder in
let fun_type = t_function input_type output_type in
let expression : expression =
e_lambda ~loc binder (Some input_type)(Some output_type) result in
let%bind expression = match kwd_recursive with
None -> ok @@ expression |
Some _ -> ok @@ e_recursive ~loc binder fun_type
@@ {binder;input_type=Some input_type; output_type= Some output_type; result}
in
ok (Some fun_type , expression)
)
| lst -> (
let lst = npseq_to_list lst in
@ -765,10 +794,15 @@ and simpl_fun_expression :
let%bind result =
let aux prec cur = cur (Some prec) in
bind_fold_right_list aux result body in
let expression =
e_lambda ~loc binder (Some (input_type)) (Some output_type) result in
let type_annotation = Some (make_t @@ T_arrow {type1=input_type;type2=output_type}) in
ok (type_annotation , expression)
let fun_type = t_function input_type output_type in
let expression : expression =
e_lambda ~loc binder (Some input_type)(Some output_type) result in
let%bind expression = match kwd_recursive with
None -> ok @@ expression |
Some _ -> ok @@ e_recursive ~loc binder fun_type
@@ {binder;input_type=Some input_type; output_type= Some output_type; result}
in
ok (Some fun_type , expression)
)
)

2
src/test/integration_tests.ml
View File

@ -2428,7 +2428,7 @@ let main = test_suite "Integration (End to End)" [
test "failwith ligo" failwith_ligo ;
test "failwith mligo" failwith_mligo ;
test "assert mligo" assert_mligo ;
(* test "recursion (ligo)" recursion_ligo ; *)
test "recursion (ligo)" recursion_ligo ;
test "recursion (mligo)" recursion_mligo ;
test "recursion (religo)" recursion_religo ;
(* test "guess string mligo" guess_string_mligo ; WIP? *)

10
test.mligo
View File

@ -1,10 +0,0 @@
type parameter = int * int
let rec fibo ((n,acc):int * int) : int =
if (n < 1) then acc
else fibo (n-1, acc+n)
let main ((p,s):parameter*int) =
let s = fibo (p) in
([] : operation list),s