test closure and higher order function

src/ligo/contracts/closure.ligo

@@ -3,3 +3,9 @@ function foo (const i : int) : int is
     block { skip } with i + j ;
   block { skip } with bar (i)
 
+function toto (const i : int) : int is
+  function tata (const j : int) : int is
+    block { skip } with i + j ;
+  function titi (const j : int) : int is
+    block { skip } with i + j ;
+  block { skip } with tata(i) + titi(i)

src/ligo/contracts/high-order.ligo

@@ -0,0 +1,6 @@
+function foobar (const i : int) : int is
+  function foo (const i : int) : int is
+    block { skip } with i ;
+  function bar (const f : int -> int) : int is
+    block { skip } with f ( i ) ;
+  block { skip } with bar (foo) ;

src/ligo/ligo_parser/AST.ml

@@ -193,6 +193,7 @@ and type_expr =
 | TSum    of (variant reg, vbar) nsepseq reg
 | TRecord of record_type
 | TApp    of (type_name * type_tuple) reg
+| TFun    of (type_expr * arrow  * type_expr) reg
 | TPar    of type_expr par reg
 | TAlias  of variable
 
@@ -672,6 +673,7 @@ let type_expr_to_region = function
 | TSum    {region; _}
 | TRecord {region; _}
 | TApp    {region; _}
+| TFun    {region; _}
 | TPar    {region; _}
 | TAlias  {region; _} -> region
 

src/ligo/ligo_parser/AST.mli

@@ -177,6 +177,7 @@ and type_expr =
 | TSum    of (variant reg, vbar) nsepseq reg
 | TRecord of record_type
 | TApp    of (type_name * type_tuple) reg
+| TFun    of (type_expr * arrow * type_expr) reg
 | TPar    of type_expr par reg
 | TAlias  of variable
 

src/ligo/ligo_parser/Parser.mly

@@ -152,10 +152,17 @@ type_expr:
 | record_type { TRecord $1 }
 
 cartesian:
-  nsepseq(core_type,TIMES) {
+  nsepseq(function_type,TIMES) {
     let region = nsepseq_to_region type_expr_to_region $1
     in {region; value=$1}}
 
+function_type:
+  core_type { $1 }
+| core_type ARROW function_type {
+    let region = cover (type_expr_to_region $1) (type_expr_to_region $3)
+    in TFun {region; value = ($1, $2, $3)}
+}
+
 core_type:
   type_name {
     TAlias $1
@@ -346,17 +353,17 @@ entry_param_decl:
     in EntryStore {region; value}}
 
 param_type:
-  nsepseq(core_param_type,TIMES) {
+  nsepseq(function_type,TIMES) {
     let region = nsepseq_to_region type_expr_to_region $1
     in TProd {region; value=$1}}
 
-core_param_type:
+/* core_param_type: */
-  type_name {
+/* type_name { */
-    TAlias $1
+/*     TAlias $1 */
-  }
+/*   } */
-| type_name type_tuple {
+/* | type_name type_tuple { */
-    let region = cover $1.region $2.region
+/*     let region = cover $1.region $2.region */
-    in TApp {region; value = $1,$2}}
+/*     in TApp {region; value = $1,$2}} */
 
 block:
   Begin series(statement,End) {

src/ligo/ligo_parser/ParserLog.ml

@@ -88,6 +88,7 @@ and print_type_expr = function
 | TSum    sum_type    -> print_sum_type    sum_type
 | TRecord record_type -> print_record_type record_type
 | TApp    type_app    -> print_type_app    type_app
+| TFun    type_fun    -> print_type_fun    type_fun
 | TPar    par_type    -> print_par_type    par_type
 | TAlias  type_alias  -> print_var         type_alias
 
@@ -111,6 +112,12 @@ and print_type_app {value; _} =
   print_var        type_name;
   print_type_tuple type_tuple
 
+and print_type_fun {value; _} =
+  let type_expr_a, arrow, type_expr_b = value in
+  print_type_expr  type_expr_a;
+  print_token      arrow "->";
+  print_type_expr  type_expr_b
+
 and print_par_type {value; _} =
   let {lpar; inside; rpar} = value in
   print_token     lpar "(";

src/ligo/simplify.ml

@@ -25,6 +25,12 @@ let rec simpl_type_expression (t:Raw.type_expr) : type_expression result =
       | None ->
           ok @@ T_variable v.value
     )
+  | TFun x -> (
+      let%bind (a , b) =
+        let (a , _ , b) = x.value in
+        bind_map_pair simpl_type_expression (a , b) in
+      ok @@ T_function (a , b)
+    )
   | TApp x ->
       let (name, tuple) = x.value in
       let lst = npseq_to_list tuple.value.inside in

src/ligo/test/integration_tests.ml

@@ -54,6 +54,32 @@ let closure () : unit result =
     bind_list
     @@ List.map aux
     @@ [0 ; 2 ; 42 ; 163 ; -1] in
+  let%bind _toto = trace (simple_error "toto") @@
+    let aux n =
+      let open AST_Typed.Combinators in
+      let input = e_a_int n in
+      let%bind result = easy_run_typed "toto" program input in
+      let expected = e_a_int ( 4 * n ) in
+      AST_Typed.assert_value_eq (expected, result)
+    in
+    bind_list
+    @@ List.map aux
+    @@ [0 ; 2 ; 42 ; 163 ; -1] in
+  ok ()
+
+let higher_order () : unit result =
+  let%bind program = type_file "./contracts/high-order.ligo" in
+  let%bind _foo = trace (simple_error "test foo") @@
+    let aux n =
+      let open AST_Typed.Combinators in
+      let input = e_a_int n in
+      let%bind result = easy_run_typed "foobar" program input in
+      let expected = e_a_int ( n ) in
+      AST_Typed.assert_value_eq (expected, result)
+    in
+    bind_list
+    @@ List.map aux
+    @@ [0 ; 2 ; 42 ; 163 ; -1] in
   ok ()
 
 let shared_function () : unit result =
@@ -542,4 +568,5 @@ let main = "Integration (End to End)", [
     test "quote declarations" quote_declarations ;
     test "#include directives" include_ ;
     test "counter contract" counter_contract ;
+    test "higher order" higher_order ;
   ]