unify a little more

This commit is contained in:
Lesenechal Remi 2019-12-06 15:10:37 +01:00
parent 26f26171e6
commit 6ed2f2b3ae
6 changed files with 31 additions and 42 deletions

View File

@ -3,44 +3,27 @@ open Tezos_utils
open Proto_alpha_utils open Proto_alpha_utils
open Trace open Trace
let compile_function_expression : expression -> Compiler.compiled_expression result = fun e -> let compile : expression -> Compiler.compiled_expression result = fun e ->
let%bind (input_ty , _) = get_t_function e.type_value in
let%bind body = get_function e in
let%bind body = Compiler.Program.translate_function_body body [] input_ty in
let expr = Self_michelson.optimize body in
let%bind expr_ty = Compiler.Type.Ty.type_ e.type_value in
let open! Compiler.Program in
ok { expr_ty ; expr }
let compile_expression : expression -> Compiler.compiled_expression result = fun e ->
let%bind expr = Compiler.Program.translate_expression e Compiler.Environment.empty in
let expr = Self_michelson.optimize expr in
let%bind expr_ty = Compiler.Type.Ty.type_ e.type_value in
let open! Compiler.Program in
ok { expr_ty ; expr }
(* let compile_function_expression_merged : expression -> Compiler.compiled_expression result = fun e ->
let%bind body = match e.type_value with let%bind body = match e.type_value with
| T_function (input_ty, _) -> | T_function (input_ty, _) ->
let%bind body = get_function e in let%bind body = get_function e in
Compiler.Program.translate_function_body body [] input_ty Compiler.Program.translate_function_body body [] input_ty
| _ -> | _ ->
Compiler.Program.translate_expression e Compiler.Environment.empty Compiler.Program.translate_expression e Compiler.Environment.empty in
in
let expr = Self_michelson.optimize body in let expr = Self_michelson.optimize body in
let%bind expr_ty = Compiler.Type.Ty.type_ e.type_value in let%bind expr_ty = Compiler.Type.Ty.type_ e.type_value in
let open! Compiler.Program in let open! Compiler.Program in
ok { expr_ty ; expr } *) ok { expr_ty ; expr }
let aggregate_and_compile_function = fun program name -> let aggregate_and_compile_function = fun program name ->
let%bind aggregated = aggregate_entry program name false in let%bind aggregated = aggregate_entry program name false in
let aggregated = Self_mini_c.all_expression aggregated in let aggregated = Self_mini_c.all_expression aggregated in
compile_function_expression aggregated compile aggregated
let aggregate_and_compile_expression = fun program name -> let aggregate_and_compile_expression = fun program name ->
let%bind aggregated = aggregate_entry program name true in let%bind aggregated = aggregate_entry program name true in
let aggregated = Self_mini_c.all_expression aggregated in let aggregated = Self_mini_c.all_expression aggregated in
compile_expression aggregated compile aggregated
let build_contract : Compiler.compiled_expression -> Michelson.michelson result = let build_contract : Compiler.compiled_expression -> Michelson.michelson result =
fun compiled -> fun compiled ->

View File

@ -6,11 +6,7 @@ let source_to_typed syntax source_file =
let env = Ast_typed.program_environment typed in let env = Ast_typed.program_environment typed in
ok (typed,state,env) ok (typed,state,env)
let source_to_typed_expression ~env ~state parameter syntax = (* fetches entry_point which is a function and transform ir into a fun (..) { let .. in let .. in body } *)
let%bind simplified = Of_source.compile_expression syntax parameter in
let%bind (typed,_) = Of_simplified.compile_expression ~env ~state simplified in
ok typed
let typed_to_michelson_fun let typed_to_michelson_fun
(typed: Ast_typed.program) (entry_point:string) : Compiler.compiled_expression result = (typed: Ast_typed.program) (entry_point:string) : Compiler.compiled_expression result =
let%bind mini_c = Of_typed.compile typed in let%bind mini_c = Of_typed.compile typed in
@ -23,15 +19,16 @@ let typed_to_michelson_expression
Of_mini_c.aggregate_and_compile_expression mini_c entry_point Of_mini_c.aggregate_and_compile_expression mini_c entry_point
let source_expression_to_michelson ~env ~state parameter syntax = let source_expression_to_michelson ~env ~state parameter syntax =
let%bind typed = source_to_typed_expression ~env ~state parameter syntax in let%bind simplified = Of_source.compile_expression syntax parameter in
let%bind (typed,_) = Of_simplified.compile_expression ~env ~state simplified in
let%bind mini_c = Of_typed.compile_expression typed in let%bind mini_c = Of_typed.compile_expression typed in
Of_mini_c.compile_expression mini_c Of_mini_c.compile mini_c
let source_contract_param_to_michelson ~env ~state (storage,parameter) syntax = let source_contract_param_to_michelson ~env ~state (storage,parameter) syntax =
let%bind simplified = Of_source.compile_contract_input storage parameter syntax in let%bind simplified = Of_source.compile_contract_input storage parameter syntax in
let%bind typed,_ = Of_simplified.compile_expression ~env ~state simplified in let%bind typed,_ = Of_simplified.compile_expression ~env ~state simplified in
let%bind mini_c = Of_typed.compile_expression typed in let%bind mini_c = Of_typed.compile_expression typed in
Of_mini_c.compile_expression mini_c Of_mini_c.compile mini_c
(* produce a michelson contract e.g. the following sequence K_param ; K_storage ; K_code. (* produce a michelson contract e.g. the following sequence K_param ; K_storage ; K_code.
and fails if the produced contract isn't valid *) and fails if the produced contract isn't valid *)

View File

@ -72,13 +72,13 @@ let run_function_aux ?options (exp:Michelson.t) (exp_type:ex_ty) (input_michelso
Trace.trace_tzresult_lwt (simple_error "error parsing input") @@ Trace.trace_tzresult_lwt (simple_error "error parsing input") @@
Memory_proto_alpha.parse_michelson_data input_michelson input_ty Memory_proto_alpha.parse_michelson_data input_michelson input_ty
in in
let (top_level, ty_stack_before, ty_stack_after) = let top_level = if is_contract then
(if is_contract then Script_ir_translator.Toplevel
Script_ir_translator.Toplevel { storage_type = output_ty ; param_type = input_ty ; { storage_type = output_ty ; param_type = input_ty ;
root_name = None ; legacy_create_contract_literal = false } root_name = None ; legacy_create_contract_literal = false }
else Script_ir_translator.Lambda) , else Script_ir_translator.Lambda
Script_typed_ir.Item_t (input_ty, Empty_t, None), and ty_stack_before = Script_typed_ir.Item_t (input_ty, Empty_t, None)
Script_typed_ir.Item_t (output_ty, Empty_t, None) in and ty_stack_after = Script_typed_ir.Item_t (output_ty, Empty_t, None) in
let exp = Michelson.strip_annots exp in let exp = Michelson.strip_annots exp in
let%bind descr = let%bind descr =
Trace.trace_tzresult_lwt (simple_error "error parsing program code") @@ Trace.trace_tzresult_lwt (simple_error "error parsing program code") @@

View File

@ -18,6 +18,11 @@ let get_program =
ok program ok program
) )
let compile_main () =
let%bind _ = Compile.Wrapper.source_to_michelson_contract
(Syntax_name "pascaligo") "./contracts/coase.ligo" "main" in
ok ()
open Ast_simplified open Ast_simplified
let card owner = let card owner =
@ -232,6 +237,7 @@ let sell () =
let main = test_suite "Coase (End to End)" [ let main = test_suite "Coase (End to End)" [
test "compile" compile_main ;
test "buy" buy ; test "buy" buy ;
test "dispatch buy" dispatch_buy ; test "dispatch buy" dispatch_buy ;
test "transfer" transfer ; test "transfer" transfer ;

View File

@ -50,7 +50,7 @@ let dummy n =
let run_typed (entry_point:string) (program:Ast_typed.program) (input:Ast_typed.annotated_expression) = let run_typed (entry_point:string) (program:Ast_typed.program) (input:Ast_typed.annotated_expression) =
let%bind program_mich = Compile.Wrapper.typed_to_michelson_fun program entry_point in let%bind program_mich = Compile.Wrapper.typed_to_michelson_fun program entry_point in
let%bind input_mini_c = Compile.Of_typed.compile_expression input in let%bind input_mini_c = Compile.Of_typed.compile_expression input in
let%bind input_mich = Compile.Of_mini_c.compile_expression input_mini_c in let%bind input_mich = Compile.Of_mini_c.compile input_mini_c in
let%bind input_eval = Run.Of_michelson.evaluate_expression input_mich.expr input_mich.expr_ty in let%bind input_eval = Run.Of_michelson.evaluate_expression input_mich.expr input_mich.expr_ty in
let%bind res = Run.Of_michelson.run_function program_mich.expr program_mich.expr_ty input_eval false in let%bind res = Run.Of_michelson.run_function program_mich.expr program_mich.expr_ty input_eval false in
let%bind output_type = let%bind output_type =

View File

@ -34,11 +34,14 @@ open Ast_simplified
let pack_payload (program:Ast_typed.program) (payload:expression) : bytes result = let pack_payload (program:Ast_typed.program) (payload:expression) : bytes result =
let%bind code = let%bind code =
let env = Ast_typed.program_environment program in
let%bind (typed,_) = Compile.Of_simplified.compile_expression let%bind (typed,_) = Compile.Of_simplified.compile_expression
~env ~state:(Typer.Solver.initial_state) payload in ~env:(Ast_typed.program_environment program) ~state:(Typer.Solver.initial_state) payload in
let%bind mini_c = Compile.Of_typed.compile_expression typed in let%bind mini_c = Compile.Of_typed.compile_expression typed in
Compile.Of_mini_c.compile_expression mini_c in let%bind expr = Compiler.Program.translate_expression mini_c Compiler.Environment.empty in
let expr = Self_michelson.optimize expr in
let%bind expr_ty = Compiler.Type.Ty.type_ mini_c.type_value in
let open! Compiler.Program in
ok { expr_ty ; expr } in
let (Ex_ty payload_ty) = code.expr_ty in let (Ex_ty payload_ty) = code.expr_ty in
let%bind (payload: Tezos_utils.Michelson.michelson) = let%bind (payload: Tezos_utils.Michelson.michelson) =
Ligo.Run.Of_michelson.evaluate_expression code.expr code.expr_ty in Ligo.Run.Of_michelson.evaluate_expression code.expr code.expr_ty in
@ -84,7 +87,7 @@ let typed_program_with_simplified_input_to_michelson
let env = Ast_typed.program_environment program in let env = Ast_typed.program_environment program in
let%bind (typed_in,_) = Compile.Of_simplified.compile_expression ~env ~state:(Typer.Solver.initial_state) input in let%bind (typed_in,_) = Compile.Of_simplified.compile_expression ~env ~state:(Typer.Solver.initial_state) input in
let%bind mini_c_in = Compile.Of_typed.compile_expression typed_in in let%bind mini_c_in = Compile.Of_typed.compile_expression typed_in in
let%bind michelson_in = Compile.Of_mini_c.compile_expression mini_c_in in let%bind michelson_in = Compile.Of_mini_c.compile mini_c_in in
let%bind evaluated_in = Ligo.Run.Of_michelson.evaluate_expression michelson_in.expr michelson_in.expr_ty in let%bind evaluated_in = Ligo.Run.Of_michelson.evaluate_expression michelson_in.expr michelson_in.expr_ty in
let%bind michelson_program = Compile.Wrapper.typed_to_michelson_fun program entry_point in let%bind michelson_program = Compile.Wrapper.typed_to_michelson_fun program entry_point in
ok (michelson_program, evaluated_in) ok (michelson_program, evaluated_in)