From b15d9a51233e7454be18679c6912a9e754cfb9c0 Mon Sep 17 00:00:00 2001 From: Pierre-Emmanuel Wulfman Date: Sat, 7 Mar 2020 01:19:22 +0100 Subject: [PATCH] compiling Pascaligo --- src/bin/expect_tests/contract_tests.ml | 6 +- src/passes/2-simplify/pascaligo.ml | 92 ++++++++++++++++++-------- src/test/integration_tests.ml | 2 +- test.mligo | 10 --- 4 files changed, 67 insertions(+), 43 deletions(-) delete mode 100644 test.mligo diff --git a/src/bin/expect_tests/contract_tests.ml b/src/bin/expect_tests/contract_tests.ml index 49d0d9ae1..9bd5723bf 100644 --- a/src/bin/expect_tests/contract_tests.ml +++ b/src/bin/expect_tests/contract_tests.ml @@ -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' |}] \ No newline at end of file + * Check the changelog by running 'ligo changelog' |}] diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index d62fc5125..6282766c1 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -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) ) ) diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index 66b9bdf05..60b8f57bb 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -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? *) diff --git a/test.mligo b/test.mligo deleted file mode 100644 index 6ee619aaa..000000000 --- a/test.mligo +++ /dev/null @@ -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 -