diff --git a/src/ligo/contracts/closure.ligo b/src/ligo/contracts/closure.ligo index f6b5933e3..d43d5400f 100644 --- a/src/ligo/contracts/closure.ligo +++ b/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) diff --git a/src/ligo/contracts/high-order.ligo b/src/ligo/contracts/high-order.ligo new file mode 100644 index 000000000..8dc7f3e4b --- /dev/null +++ b/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) ; diff --git a/src/ligo/ligo_parser/AST.ml b/src/ligo/ligo_parser/AST.ml index 3961a7f93..6b89d2434 100644 --- a/src/ligo/ligo_parser/AST.ml +++ b/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 diff --git a/src/ligo/ligo_parser/AST.mli b/src/ligo/ligo_parser/AST.mli index 0cf938adb..6901c2607 100644 --- a/src/ligo/ligo_parser/AST.mli +++ b/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 diff --git a/src/ligo/ligo_parser/Parser.mly b/src/ligo/ligo_parser/Parser.mly index 2bb26efe4..e22e6e2a7 100644 --- a/src/ligo/ligo_parser/Parser.mly +++ b/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: - type_name { - TAlias $1 - } -| type_name type_tuple { - let region = cover $1.region $2.region - in TApp {region; value = $1,$2}} +/* core_param_type: */ +/* type_name { */ +/* TAlias $1 */ +/* } */ +/* | type_name type_tuple { */ +/* let region = cover $1.region $2.region */ +/* in TApp {region; value = $1,$2}} */ block: Begin series(statement,End) { diff --git a/src/ligo/ligo_parser/ParserLog.ml b/src/ligo/ligo_parser/ParserLog.ml index ad7085e20..f78edc7a2 100644 --- a/src/ligo/ligo_parser/ParserLog.ml +++ b/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 "("; diff --git a/src/ligo/simplify.ml b/src/ligo/simplify.ml index 8a3698f05..30cf4af65 100644 --- a/src/ligo/simplify.ml +++ b/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 diff --git a/src/ligo/test/integration_tests.ml b/src/ligo/test/integration_tests.ml index 41826f4f7..bf1dca41b 100644 --- a/src/ligo/test/integration_tests.ml +++ b/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 ; ]