add and test more ways to do function application in pascaligo
This commit is contained in:
parent
628d818163
commit
d0efbd9f92
@ -580,7 +580,7 @@ and selection =
|
||||
|
||||
and tuple_expr = (expr, comma) nsepseq par reg
|
||||
|
||||
and fun_call = (fun_name * arguments) reg
|
||||
and fun_call = (expr * arguments) reg
|
||||
|
||||
and arguments = tuple_expr
|
||||
|
||||
|
@ -570,7 +570,7 @@ and selection =
|
||||
|
||||
and tuple_expr = (expr, comma) nsepseq par reg
|
||||
|
||||
and fun_call = (fun_name * arguments) reg
|
||||
and fun_call = (expr * arguments) reg
|
||||
|
||||
and arguments = tuple_expr
|
||||
|
||||
|
@ -863,14 +863,12 @@ core_expr:
|
||||
| Unit { EUnit $1 }
|
||||
| annot_expr { EAnnot $1 }
|
||||
| tuple_expr { ETuple $1 }
|
||||
| par(expr) { EPar $1 }
|
||||
| list_expr { EList $1 }
|
||||
| C_None { EConstr (NoneExpr $1) }
|
||||
| fun_call { ECall $1 }
|
||||
| fun_call_or_par_or_projection { $1 }
|
||||
| map_expr { EMap $1 }
|
||||
| set_expr { ESet $1 }
|
||||
| record_expr { ERecord $1 }
|
||||
| projection { EProj $1 }
|
||||
| Constr arguments {
|
||||
let region = cover $1.region $2.region in
|
||||
EConstr (ConstrApp {region; value = $1, Some $2})
|
||||
@ -882,6 +880,30 @@ core_expr:
|
||||
let region = cover $1 $2.region in
|
||||
EConstr (SomeApp {region; value = $1,$2})}
|
||||
|
||||
|
||||
fun_call_or_par_or_projection:
|
||||
| par(expr) option(arguments) {
|
||||
let parenthesized = EPar $1 in
|
||||
match $2 with
|
||||
| None -> parenthesized
|
||||
| Some args -> (
|
||||
let region_1 = $1.region in
|
||||
let region = cover region_1 args.region in
|
||||
ECall {region; value = parenthesized,args}
|
||||
)
|
||||
}
|
||||
| projection option(arguments) {
|
||||
let project = EProj $1 in
|
||||
match $2 with
|
||||
| None -> project
|
||||
| Some args -> (
|
||||
let region_1 = $1.region in
|
||||
let region = cover region_1 args.region in
|
||||
ECall {region; value = project,args}
|
||||
)
|
||||
}
|
||||
| fun_call { ECall $1 }
|
||||
|
||||
annot_expr:
|
||||
LPAR disj_expr COLON type_expr RPAR {
|
||||
let start = expr_to_region $2
|
||||
@ -956,7 +978,7 @@ field_assignment:
|
||||
fun_call:
|
||||
fun_name arguments {
|
||||
let region = cover $1.region $2.region
|
||||
in {region; value = $1,$2}}
|
||||
in {region; value = (EVar $1),$2}}
|
||||
|
||||
tuple_expr:
|
||||
par(tuple_comp) { $1 }
|
||||
|
@ -655,8 +655,8 @@ and print_nil buffer value = print_token buffer value "nil"
|
||||
and print_none_expr buffer value = print_token buffer value "None"
|
||||
|
||||
and print_fun_call buffer {value; _} =
|
||||
let fun_name, arguments = value in
|
||||
print_var buffer fun_name;
|
||||
let expr, arguments = value in
|
||||
print_expr buffer expr;
|
||||
print_tuple_expr buffer arguments
|
||||
|
||||
and print_constr_app buffer {value; _} =
|
||||
@ -1247,12 +1247,12 @@ and pp_var_binding buffer ~pad:(_,pc as pad) (source, image) =
|
||||
pp_ident buffer ~pad:(mk_pad 2 0 pc) source;
|
||||
pp_ident buffer ~pad:(mk_pad 2 1 pc) image
|
||||
|
||||
and pp_fun_call buffer ~pad:(_,pc) (name, args) =
|
||||
and pp_fun_call buffer ~pad:(_,pc) (expr, args) =
|
||||
let args = Utils.nsepseq_to_list args.value.inside in
|
||||
let arity = List.length args in
|
||||
let apply len rank =
|
||||
pp_expr buffer ~pad:(mk_pad len rank pc)
|
||||
in pp_ident buffer ~pad:(mk_pad (1+arity) 0 pc) name;
|
||||
in pp_expr buffer ~pad:(mk_pad (1+arity) 0 pc) expr;
|
||||
List.iteri (apply arity) args
|
||||
|
||||
and pp_record_patch buffer ~pad:(_,pc as pad) patch =
|
||||
|
@ -263,17 +263,25 @@ let rec simpl_expression (t:Raw.expr) : expr result =
|
||||
| Some s -> return @@ e_constant ~loc s []
|
||||
)
|
||||
| ECall x -> (
|
||||
let ((name, args) , loc) = r_split x in
|
||||
let (f , f_loc) = r_split name in
|
||||
let ((f, args) , loc) = r_split x in
|
||||
let (args , args_loc) = r_split args in
|
||||
let args' = npseq_to_list args.inside in
|
||||
match List.assoc_opt f constants with
|
||||
| None ->
|
||||
let%bind arg = simpl_tuple_expression ~loc:args_loc args' in
|
||||
return @@ e_application ~loc (e_variable ~loc:f_loc f) arg
|
||||
| Some s ->
|
||||
let%bind lst = bind_map_list simpl_expression args' in
|
||||
return @@ e_constant ~loc s lst
|
||||
match f with
|
||||
| EVar name -> (
|
||||
let (f_name , f_loc) = r_split name in
|
||||
match List.assoc_opt f_name constants with
|
||||
| None ->
|
||||
let%bind arg = simpl_tuple_expression ~loc:args_loc args' in
|
||||
return @@ e_application ~loc (e_variable ~loc:f_loc f_name) arg
|
||||
| Some s ->
|
||||
let%bind lst = bind_map_list simpl_expression args' in
|
||||
return @@ e_constant ~loc s lst
|
||||
)
|
||||
| f -> (
|
||||
let%bind f' = simpl_expression f in
|
||||
let%bind arg = simpl_tuple_expression ~loc:args_loc args' in
|
||||
return @@ e_application ~loc f' arg
|
||||
)
|
||||
)
|
||||
| EPar x -> simpl_expression x.value.inside
|
||||
| EUnit reg ->
|
||||
@ -630,18 +638,26 @@ and simpl_single_instruction : Raw.instruction -> (_ -> expression result) resul
|
||||
fun t ->
|
||||
match t with
|
||||
| ProcCall x -> (
|
||||
let ((name, args) , loc) = r_split x in
|
||||
let (f , f_loc) = r_split name in
|
||||
let (args , args_loc) = r_split args in
|
||||
let args' = npseq_to_list args.inside in
|
||||
match List.assoc_opt f constants with
|
||||
let ((f, args) , loc) = r_split x in
|
||||
let (args , args_loc) = r_split args in
|
||||
let args' = npseq_to_list args.inside in
|
||||
match f with
|
||||
| EVar name -> (
|
||||
let (f_name , f_loc) = r_split name in
|
||||
match List.assoc_opt f_name constants with
|
||||
| None ->
|
||||
let%bind arg = simpl_tuple_expression ~loc:args_loc args' in
|
||||
return_statement @@ e_application ~loc (e_variable ~loc:f_loc f) arg
|
||||
let%bind arg = simpl_tuple_expression ~loc:args_loc args' in
|
||||
return_statement @@ e_application ~loc (e_variable ~loc:f_loc f_name) arg
|
||||
| Some s ->
|
||||
let%bind lst = bind_map_list simpl_expression args' in
|
||||
return_statement @@ e_constant ~loc s lst
|
||||
let%bind lst = bind_map_list simpl_expression args' in
|
||||
return_statement @@ e_constant ~loc s lst
|
||||
)
|
||||
| f -> (
|
||||
let%bind f' = simpl_expression f in
|
||||
let%bind arg = simpl_tuple_expression ~loc:args_loc args' in
|
||||
return_statement @@ e_application ~loc f' arg
|
||||
)
|
||||
)
|
||||
| Skip reg -> (
|
||||
let loc = Location.lift reg in
|
||||
return_statement @@ e_skip ~loc ()
|
||||
|
21
src/test/contracts/application.ligo
Normal file
21
src/test/contracts/application.ligo
Normal file
@ -0,0 +1,21 @@
|
||||
// Test different ways of calling functions in PascaLIGO
|
||||
|
||||
type foo is record
|
||||
bar : int -> int ;
|
||||
end
|
||||
|
||||
function f (const i : int) : int is
|
||||
begin
|
||||
skip
|
||||
end with i
|
||||
|
||||
function g (const i : unit) : int -> int is
|
||||
begin skip end with f
|
||||
|
||||
const r : foo = record
|
||||
bar = f ;
|
||||
end
|
||||
|
||||
const x : int = f(42)
|
||||
const y : int = r.bar(42)
|
||||
const z : int = (g(unit))(42)
|
@ -52,6 +52,19 @@ let complex_function () : unit result =
|
||||
let make_expect = fun n -> (3 * n + 2) in
|
||||
expect_eq_n_int program "main" make_expect
|
||||
|
||||
let application () : unit result =
|
||||
let%bind program = type_file "./contracts/application.ligo" in
|
||||
let%bind () =
|
||||
let expected = e_int 42 in
|
||||
expect_eq_evaluate program "x" expected in
|
||||
let%bind () =
|
||||
let expected = e_int 42 in
|
||||
expect_eq_evaluate program "y" expected in
|
||||
let%bind () =
|
||||
let expected = e_int 42 in
|
||||
expect_eq_evaluate program "z" expected in
|
||||
ok ()
|
||||
|
||||
let variant () : unit result =
|
||||
let%bind program = type_file "./contracts/variant.ligo" in
|
||||
let%bind () =
|
||||
@ -1164,6 +1177,7 @@ let main = test_suite "Integration (End to End)" [
|
||||
test "assign" assign ;
|
||||
test "declaration local" declaration_local ;
|
||||
test "complex function" complex_function ;
|
||||
test "various applications" application ;
|
||||
test "closure" closure ;
|
||||
test "shared function" shared_function ;
|
||||
test "shared function (mligo)" shared_function_mligo ;
|
||||
|
Loading…
Reference in New Issue
Block a user