compiling Pascaligo

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

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,7 +747,7 @@ 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, [] -> (
@@ -737,10 +760,16 @@ 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 : 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)
+      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)
      )
   )
 

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? *)

test.mligo

@@ -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
-