diff --git a/src/bin/cli.ml b/src/bin/cli.ml index 5f5809170..181ffa43e 100644 --- a/src/bin/cli.ml +++ b/src/bin/cli.ml @@ -153,7 +153,7 @@ let compile_parameter = let%bind simplified_param = Compile.Of_source.compile_expression v_syntax expression in let%bind (typed_param,_) = Compile.Of_simplified.compile_expression ~env ~state simplified_param in let%bind mini_c_param = Compile.Of_typed.compile_expression typed_param in - let%bind compiled_param = Compile.Of_mini_c.aggregate_and_compile_expression mini_c_prg (Expression mini_c_param) [] in + let%bind compiled_param = Compile.Of_mini_c.aggregate_and_compile_expression mini_c_prg mini_c_param in let%bind value = Run.evaluate_expression compiled_param.expr compiled_param.expr_ty in ok @@ Format.asprintf "%a\n" (Main.Display.michelson_pp michelson_format) value in @@ -235,10 +235,11 @@ let run_function = let%bind mini_c_prg = Compile.Of_typed.compile typed_prg in let%bind simplified_param = Compile.Of_source.compile_expression v_syntax parameter in - let%bind (typed_param,_) = Compile.Of_simplified.compile_expression ~env ~state simplified_param in - let%bind compiled_param = Compile.Of_typed.compile_expression typed_param in + let%bind app = Compile.Of_simplified.apply entry_point simplified_param in + let%bind (typed_app,_) = Compile.Of_simplified.compile_expression ~env ~state app in + let%bind compiled_applied = Compile.Of_typed.compile_expression typed_app in - let%bind michelson = Compile.Of_mini_c.aggregate_and_compile_expression mini_c_prg (Entry_name entry_point) [compiled_param] in + let%bind michelson = Compile.Of_mini_c.aggregate_and_compile_expression mini_c_prg compiled_applied in let%bind options = Run.make_dry_run_options {amount ; sender ; source } in let%bind michelson_output = Run.run ~options michelson.expr michelson.expr_ty in let%bind simplified_output = Uncompile.uncompile_typed_program_entry_function_result typed_prg entry_point michelson_output in @@ -257,7 +258,7 @@ let evaluate_value = let%bind typed_prg,_ = Compile.Of_simplified.compile simplified in let%bind mini_c = Compile.Of_typed.compile typed_prg in let%bind (exp,_) = Mini_c.get_entry mini_c entry_point in - let%bind compiled = Compile.Of_mini_c.aggregate_and_compile_expression mini_c (Expression exp) [] in + let%bind compiled = Compile.Of_mini_c.aggregate_and_compile_expression mini_c exp in let%bind options = Run.make_dry_run_options {amount ; sender ; source } in let%bind michelson_output = Run.run ~options compiled.expr compiled.expr_ty in let%bind simplified_output = Uncompile.uncompile_typed_program_entry_expression_result typed_prg entry_point michelson_output in diff --git a/src/main/compile/of_mini_c.ml b/src/main/compile/of_mini_c.ml index b715f55af..0ed53895f 100644 --- a/src/main/compile/of_mini_c.ml +++ b/src/main/compile/of_mini_c.ml @@ -27,32 +27,23 @@ let aggregate_and_compile = fun program form -> | ExpressionForm _ -> compile_expression aggregated' let aggregate_and_compile_contract = fun program name -> - let%bind (exp, idx) = get_entry program name in - aggregate_and_compile program (ContractForm (exp, idx)) + let%bind (exp, _) = get_entry program name in + aggregate_and_compile program (ContractForm exp) -type compiled_expression_t = - | Expression of expression - | Entry_name of string - -let aggregate_and_compile_expression = fun program exp args -> - match exp with - | Expression exp -> - aggregate_and_compile program (ExpressionForm ((exp,List.length program), args)) - | Entry_name name -> - let%bind (exp, idx) = get_entry program name in - aggregate_and_compile program (ExpressionForm ((exp,idx), args)) +let aggregate_and_compile_expression = fun program exp -> + aggregate_and_compile program (ExpressionForm exp) let build_contract : Compiler.compiled_expression -> Michelson.michelson result = fun compiled -> - let%bind ((Ex_ty _param_ty),(Ex_ty _storage_ty)) = Self_michelson.fetch_lambda_parameters compiled.expr_ty in + let%bind ((Ex_ty _param_ty),(Ex_ty _storage_ty)) = Self_michelson.fetch_contract_inputs compiled.expr_ty in let%bind param_michelson = - Trace.trace_tzresult_lwt (simple_error "Could not unparse contract lambda's parameter") @@ + Trace.trace_tzresult_lwt (simple_error "Invalid contract: Could not unparse parameter") @@ Proto_alpha_utils.Memory_proto_alpha.unparse_ty_michelson _param_ty in let%bind storage_michelson = - Trace.trace_tzresult_lwt (simple_error "Could not unparse contract lambda's storage") @@ + Trace.trace_tzresult_lwt (simple_error "Invalid contract: Could not unparse storage") @@ Proto_alpha_utils.Memory_proto_alpha.unparse_ty_michelson _storage_ty in let contract = Michelson.contract param_michelson storage_michelson compiled.expr in let%bind () = - Trace.trace_tzresult_lwt (simple_error "Invalid contract") @@ + Trace.trace_tzresult_lwt (simple_error "Invalid contract: Contract did not typecheck") @@ Proto_alpha_utils.Memory_proto_alpha.typecheck_contract contract in ok contract diff --git a/src/main/compile/of_simplified.ml b/src/main/compile/of_simplified.ml index 682181bf5..59df4d647 100644 --- a/src/main/compile/of_simplified.ml +++ b/src/main/compile/of_simplified.ml @@ -5,5 +5,16 @@ let compile (program : Ast_simplified.program) : (Ast_typed.program * Typer.Solv let () = Typer.Solver.discard_state state in ok @@ (prog_typed, state) -let compile_expression ?(env = Ast_typed.Environment.full_empty) ~(state : Typer.Solver.state) (ae : Ast_simplified.expression) : (Ast_typed.value * Typer.Solver.state) result = - Typer.type_expression env state ae \ No newline at end of file +let compile_expression ?(env = Ast_typed.Environment.full_empty) ~(state : Typer.Solver.state) (ae : Ast_simplified.expression) + : (Ast_typed.value * Typer.Solver.state) result = + Typer.type_expression env state ae + +let apply (entry_point : string) (param : Ast_simplified.expression) : Ast_simplified.expression result = + let name = Var.of_name entry_point in + let entry_point_var : Ast_simplified.expression = + { expression = Ast_simplified.E_variable name ; + location = Virtual "generated entry-point variable" } in + let applied : Ast_simplified.expression = + { expression = Ast_simplified.E_application (entry_point_var, param) ; + location = Virtual "generated application" } in + ok applied diff --git a/src/passes/9-self_michelson/helpers.ml b/src/passes/9-self_michelson/helpers.ml index feca5a151..f7421546c 100644 --- a/src/passes/9-self_michelson/helpers.ml +++ b/src/passes/9-self_michelson/helpers.ml @@ -19,9 +19,8 @@ let rec map_expression : mapper -> michelson -> michelson result = fun f e -> | x -> ok x open Memory_proto_alpha.Protocol.Script_ir_translator -(* fetches lambda first and second parameter (parameter,storage) *) -let fetch_lambda_parameters : ex_ty -> (ex_ty * ex_ty) result = - let error () = simple_fail "failed to fetch lambda parameters" in +let fetch_contract_inputs : ex_ty -> (ex_ty * ex_ty) result = + let error () = simple_fail "Invalid contract: Failed to fetch parameter and storage" in function | Ex_ty (Lambda_t (in_ty, _, _)) -> ( match in_ty with diff --git a/src/stages/ast_simplified/misc.mli b/src/stages/ast_simplified/misc.mli index efafd75e6..9ef833e55 100644 --- a/src/stages/ast_simplified/misc.mli +++ b/src/stages/ast_simplified/misc.mli @@ -15,4 +15,4 @@ val assert_literal_eq : ( literal * literal ) -> unit result val assert_value_eq : ( expression * expression ) -> unit result -val is_value_eq : ( expression * expression ) -> bool +val is_value_eq : ( expression * expression ) -> bool \ No newline at end of file diff --git a/src/stages/mini_c/misc.ml b/src/stages/mini_c/misc.ml index 09619b927..5cae24799 100644 --- a/src/stages/mini_c/misc.ml +++ b/src/stages/mini_c/misc.ml @@ -140,60 +140,29 @@ let get_entry (lst : program) (name : string) : (expression * int) result = in ok (entry_expression , entry_index) -(* - Assume the following program: - ``` - const x = 42 - const y = 120 - const f = () -> x + y - ``` - aggregate_entry program "f" (Some [unit]) would return: - ``` - let x = 42 in - let y = 120 in - const f = () -> x + y - f(unit) - ``` - - if arg_lst is None, it means that the entry point is not an arbitrary expression -*) type form_t = - | ContractForm of (expression * int) - | ExpressionForm of ((expression * int) * expression list) + | ContractForm of expression + | ExpressionForm of expression let aggregate_entry (lst : program) (form : form_t) : expression result = - let (entry_expression , entry_index, arg_lst) = match form with - | ContractForm (exp,i) -> (exp,i,[]) - | ExpressionForm ((exp,i),argl) -> (exp,i,argl) in - let pre_declarations = List.until entry_index lst in let wrapper = let aux prec cur = let (((name , expr) , _)) = cur in e_let_in name expr.type_value expr prec in - fun expr -> List.fold_right' aux expr pre_declarations + fun expr -> List.fold_right' aux expr lst in - match (entry_expression.content , arg_lst) with - | (E_closure _ , (hd::tl)) -> ( - let%bind type_value' = match entry_expression.type_value with - | T_function (_,t) -> ok t - | _ -> simple_fail "Trying to aggregate closure which does not have function type" in - let entry_expression' = List.fold_left - (fun acc el -> - let type_value' = match acc.type_value with - | T_function (_,t) -> t - | e -> e in - { - content = E_application (acc,el) ; - type_value = type_value' ; - } - ) - { - content = E_application (entry_expression, hd) ; - type_value = type_value' ; - } tl in - ok @@ wrapper entry_expression' - ) - | (_ , _) -> ( - ok @@ wrapper entry_expression - ) \ No newline at end of file + match form with + | ContractForm entry_expression -> ( + match (entry_expression.content) with + | (E_closure l) -> ( + let l' = { l with body = wrapper l.body } in + let e' = { + content = E_closure l' ; + type_value = entry_expression.type_value ; + } in + ok e' + ) + | _ -> simple_fail "a contract must be a closure" ) + | ExpressionForm entry_expression -> + ok @@ wrapper entry_expression \ No newline at end of file diff --git a/src/test/contracts/balance_constant.ligo b/src/test/contracts/balance_constant.ligo index 6f78d339a..cbe69d3c1 100644 --- a/src/test/contracts/balance_constant.ligo +++ b/src/test/contracts/balance_constant.ligo @@ -7,5 +7,5 @@ It's there to detect a regression of: https://gitlab.com/ligolang/ligo/issues/68 type storage is tez -function main (const p : unit; const s: int) : list(operation) * storage is +function main (const p : unit; const s: tez) : list(operation) * storage is ((nil : list(operation)), balance) diff --git a/src/test/heap_tests.ml b/src/test/heap_tests.ml deleted file mode 100644 index a678d1853..000000000 --- a/src/test/heap_tests.ml +++ /dev/null @@ -1,143 +0,0 @@ -open Trace -open Test_helpers - -let type_file f = - let%bind simplified = Ligo.Compile.Of_source.compile f (Syntax_name "pascaligo") in - let%bind typed,state = Ligo.Compile.Of_simplified.compile simplified in - ok @@ (typed,state) - -let get_program = - let s = ref None in - fun () -> match !s with - | Some s -> ok s - | None -> ( - let%bind (program , state) = type_file "./contracts/heap-instance.ligo" in - let () = Typer.Solver.discard_state state in - s := Some program ; - ok program - ) - -let a_heap_ez ?value_type (content:(int * Ast_typed.ae) list) = - let open Ast_typed.Combinators in - let content = - let aux = fun (x, y) -> e_a_empty_nat x, y in - List.map aux content in - let value_type = match value_type, content with - | None, hd :: _ -> (snd hd).type_annotation - | Some s, _ -> s - | _ -> raise (Failure "no value type and heap empty when building heap") in - e_a_empty_map content (t_nat ()) value_type - -let ez lst = - let open Ast_typed.Combinators in - let value_type = t_pair - (t_int ()) - (t_string ()) - () - in - let lst' = - let aux (i, (j, s)) = - (i, e_a_empty_pair (e_a_empty_int j) (e_a_empty_string s)) in - List.map aux lst in - a_heap_ez ~value_type lst' - -let dummy n = - ez List.( - map (fun n -> (n, (n, string_of_int n))) - @@ tl - @@ range (n + 1) - ) - -let run_typed (entry_point:string) (program:Ast_typed.program) (input:Ast_typed.annotated_expression) = - let%bind input_mini_c = Compile.Of_typed.compile_expression input in - let%bind mini_c = Compile.Of_typed.compile program in - let%bind program_mich = Compile.Of_mini_c.aggregate_and_compile_expression - mini_c (Entry_name entry_point) [input_mini_c] in - let%bind res = Run.Of_michelson.run program_mich.expr program_mich.expr_ty in - let%bind output_type = - let%bind entry_expression = Ast_typed.get_entry program entry_point in - let%bind (_ , output_type) = Ast_typed.get_t_function entry_expression.type_annotation in - ok output_type - in - let%bind mini_c = Compiler.Uncompiler.translate_value res in - Transpiler.untranspile mini_c output_type - -let is_empty () : unit result = - let%bind program = get_program () in - let aux n = - let open Ast_typed.Combinators in - let input = dummy n in - let%bind result = run_typed "is_empty" program input in - let expected = e_a_empty_bool (n = 0) in - Ast_typed.assert_value_eq (expected, result) - in - let%bind _ = bind_list - @@ List.map aux - @@ [0 ; 2 ; 7 ; 12] in - ok () - -let get_top () : unit result = - let%bind program = get_program () in - let aux n = - let open Ast_typed.Combinators in - let input = dummy n in - match n, run_typed "get_top" program input with - | 0, Trace.Ok _ -> simple_fail "unexpected success" - | 0, _ -> ok () - | _, result -> - let%bind result' = result in - let expected = e_a_empty_pair (e_a_empty_int 1) (e_a_empty_string "1") in - Ast_typed.assert_value_eq (expected, result') - in - let%bind _ = bind_list - @@ List.map aux - @@ [0 ; 2 ; 7 ; 12] in - ok () - -let pop_switch () : unit result = - let%bind program = get_program () in - let aux n = - let input = dummy n in - match n, run_typed "pop_switch" program input with - | 0, Trace.Ok _ -> simple_fail "unexpected success" - | 0, _ -> ok () - | _, result -> - let%bind result' = result in - let expected = ez List.( - map (fun i -> if i = 1 then (1, (n, string_of_int n)) else (i, (i, string_of_int i))) - @@ tl - @@ range (n + 1) - ) in - Ast_typed.assert_value_eq (expected, result') - in - let%bind _ = bind_list - @@ List.map aux - @@ [0 ; 2 ; 7 ; 12] in - ok () - -let pop () : unit result = - let%bind program = get_program () in - let aux n = - let input = dummy n in - (match run_typed "pop" program input with - | Trace.Ok (output , _) -> ( - Format.printf "\nPop output on %d : %a\n" n Ast_typed.PP.annotated_expression output ; - ) - | Trace.Error err -> ( - Format.printf "\nPop output on %d : error\n" n) ; - Format.printf "Errors : {\n%a}\n%!" error_pp (err ()) ; - ) ; - ok () - in - let%bind _ = bind_list - @@ List.map aux - @@ [2 ; 7 ; 12] in - simple_fail "display" - (* ok () *) - -let main = test_suite "Heap (End to End)" [ - test "is_empty" is_empty ; - test "get_top" get_top ; - test "pop_switch" pop_switch ; - (* test "pop" pop ; *) - ] diff --git a/src/test/test.ml b/src/test/test.ml index e152ab1b1..4db386e5e 100644 --- a/src/test/test.ml +++ b/src/test/test.ml @@ -8,7 +8,6 @@ let () = Integration_tests.main ; Transpiler_tests.main ; Typer_tests.main ; - Heap_tests.main ; Coase_tests.main ; Vote_tests.main ; Multisig_tests.main ; diff --git a/src/test/test_helpers.ml b/src/test/test_helpers.ml index 7ea253b01..5c3e6d771 100644 --- a/src/test/test_helpers.ml +++ b/src/test/test_helpers.ml @@ -83,10 +83,11 @@ let typed_program_with_simplified_input_to_michelson (input: Ast_simplified.expression) : Compiler.compiled_expression result = let env = Ast_typed.program_environment program in let state = Typer.Solver.initial_state in - let%bind (typed_in,_) = Compile.Of_simplified.compile_expression ~env ~state input in - let%bind mini_c_in = Compile.Of_typed.compile_expression typed_in in - let%bind mini_c_prg = Compile.Of_typed.compile program in - Compile.Of_mini_c.aggregate_and_compile_expression mini_c_prg (Entry_name entry_point) [mini_c_in] + let%bind app = Compile.Of_simplified.apply entry_point input in + let%bind (typed_app,_) = Compile.Of_simplified.compile_expression ~env ~state app in + let%bind compiled_applied = Compile.Of_typed.compile_expression typed_app in + let%bind mini_c_prg = Compile.Of_typed.compile program in + Compile.Of_mini_c.aggregate_and_compile_expression mini_c_prg compiled_applied let run_typed_program_with_simplified_input ?options (program: Ast_typed.program) (entry_point: string) @@ -143,10 +144,11 @@ let expect_evaluate program entry_point expecter = let content () = Format.asprintf "Entry_point: %s" entry_point in error title content in trace error @@ - let%bind mini_c = Ligo.Compile.Of_typed.compile program in - let%bind michelson_value = Ligo.Compile.Of_mini_c.aggregate_and_compile_expression mini_c (Entry_name entry_point) [] in - let%bind res_michelson = Ligo.Run.Of_michelson.run michelson_value.expr michelson_value.expr_ty in - let%bind res_simpl = Uncompile.uncompile_typed_program_entry_expression_result program entry_point res_michelson in + let%bind mini_c = Ligo.Compile.Of_typed.compile program in + let%bind (exp,_) = Mini_c.get_entry mini_c entry_point in + let%bind michelson_value = Ligo.Compile.Of_mini_c.aggregate_and_compile_expression mini_c exp in + let%bind res_michelson = Ligo.Run.Of_michelson.run michelson_value.expr michelson_value.expr_ty in + let%bind res_simpl = Uncompile.uncompile_typed_program_entry_expression_result program entry_point res_michelson in expecter res_simpl let expect_eq_evaluate program entry_point expected =