This commit is contained in:
galfour 2019-09-22 23:39:15 +02:00
parent 37836f9512
commit 96fd0b4660
9 changed files with 83 additions and 16 deletions

View File

@ -103,7 +103,7 @@ let compile_storage =
toplevel ~display_format @@
let%bind value =
trace (simple_error "compile-storage") @@
Ligo.Compile.Of_source.compile_file_contract_storage ~bigmap source entry_point expression (Syntax_name syntax) in
Ligo.Compile.Of_source.compile_file_contract_storage ~value:bigmap source entry_point expression (Syntax_name syntax) in
ok @@ Format.asprintf "%a\n" Tezos_utils.Michelson.pp value
in
let term =
@ -116,7 +116,7 @@ let dry_run =
let f source entry_point storage input amount syntax display_format bigmap =
toplevel ~display_format @@
let%bind output =
Ligo.Run.Of_source.run_contract ~amount ~bigmap source entry_point storage input (Syntax_name syntax) in
Ligo.Run.Of_source.run_contract ~amount ~storage_value:bigmap source entry_point storage input (Syntax_name syntax) in
ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression output
in
let term =

View File

@ -5,8 +5,16 @@ open Tezos_utils
let compile_value : value -> type_value -> Michelson.t result =
Compiler.Program.translate_value
let compile_expression : expression -> _ result = fun e ->
Compiler.Program.translate_expression e Compiler.Environment.empty
let compile_expression ?(value = false) : expression -> _ result = fun e ->
if value then (
let%bind value = expression_to_value e in
Format.printf "Compile to value\n" ;
let%bind result = compile_value value e.type_value in
Format.printf "Compiled to value\n" ;
ok result
) else (
Compiler.Program.translate_expression e Compiler.Environment.empty
)
let compile_expression_as_function : expression -> _ result = fun e ->
let (input , output) = t_unit , e.type_value in

View File

@ -30,19 +30,19 @@ let compile_file_expression : string -> string -> string -> s_syntax -> Michelso
let%bind simplified = parsify_expression syntax expression in
Of_simplified.compile_expression simplified
let compile_file_contract_storage : string -> string -> string -> s_syntax -> Michelson.t result =
let compile_file_contract_storage ~value : string -> string -> string -> s_syntax -> Michelson.t result =
fun source_filename _entry_point expression syntax ->
let%bind syntax = syntax_to_variant syntax (Some source_filename) in
let%bind simplified = parsify_expression syntax expression in
Of_simplified.compile_expression simplified
Of_simplified.compile_expression ~value simplified
let compile_file_contract_args =
fun source_filename _entry_point storage parameter syntax ->
fun ?value source_filename _entry_point storage parameter syntax ->
let%bind syntax = syntax_to_variant syntax (Some source_filename) in
let%bind storage_simplified = parsify_expression syntax storage in
let%bind parameter_simplified = parsify_expression syntax parameter in
let args = Ast_simplified.e_pair storage_simplified parameter_simplified in
Of_simplified.compile_expression args
Of_simplified.compile_expression ?value args
let type_file ?(debug_simplify = false) ?(debug_typed = false)
syntax (source_filename:string) : Ast_typed.program result =

View File

@ -4,9 +4,8 @@ open Tezos_utils
let compile_expression ?(value = false) : annotated_expression -> Michelson.t result = fun e ->
let _ = value in
let%bind mini_c_expression = Transpiler.transpile_annotated_expression e in
let%bind expr = Of_mini_c.compile_expression mini_c_expression in
let%bind expr = Of_mini_c.compile_expression ~value mini_c_expression in
ok expr
let compile_expression_as_function : annotated_expression -> _ result = fun e ->

View File

@ -15,7 +15,7 @@ let run_typed_program
let env = get_final_environment program in
Compile.Of_simplified.compile_expression ~env ?value:input_to_value input
in
let%bind ex_ty_value = Of_michelson.run ?options code input in
let%bind ex_ty_value = Of_michelson.run ?is_input_value:input_to_value ?options code input in
Compile.Of_simplified.uncompile_typed_program_entry_function_result program entry ex_ty_value
let evaluate_typed_program_entry

View File

@ -46,10 +46,10 @@ include struct
ok ()
end
let run_contract ?amount source_filename entry_point storage parameter syntax =
let run_contract ?amount ?storage_value source_filename entry_point storage parameter syntax =
let%bind program = Compile.Of_source.type_file syntax source_filename in
let%bind code = Compile.Of_typed.compile_function_entry program entry_point in
let%bind args = Compile.Of_source.compile_file_contract_args source_filename entry_point storage parameter syntax in
let%bind args = Compile.Of_source.compile_file_contract_args ?value:storage_value source_filename entry_point storage parameter syntax in
let%bind ex_value_ty =
let options =
let open Proto_alpha_utils.Memory_proto_alpha in

View File

@ -80,7 +80,9 @@ let rec translate_value ?bm_opt (Ex_typed_value (ty, value)) : value result =
let%bind original_big_map =
match bm_opt with
| Some (D_big_map l) -> ok @@ l
| _ -> fail @@ simple_error "Do not have access to the original big_map" in
| _ -> ok []
(* | _ -> fail @@ simple_error "Do not have access to the original big_map" . When does this matter? *)
in
let%bind lst' =
let aux orig (k, v) =
let%bind k' = translate_value (Ex_typed_value (k_ty, k)) in

View File

@ -106,3 +106,61 @@ let aggregate_entry (lst : program) (name : string) (to_functionalize : bool) :
Format.printf "Not functional: %a\n" PP.expression entry_expression ;
fail @@ Errors.not_functional_main name
)
let rec expression_to_value (exp: expression) : value result =
match exp.content with
| E_literal v -> ok @@ v
| E_constant ("map" , lst) ->
let aux el =
let%bind l = expression_to_value el in
match l with
| D_pair (a , b) -> ok @@ (a , b)
| _ -> fail @@ simple_error "??" in
let%bind lstl = bind_map_list aux lst in
ok @@ D_map lstl
| E_constant ("big_map" , lst) ->
let aux el =
let%bind l = expression_to_value el in
match l with
| D_pair (a , b) -> ok @@ (a , b)
| _ -> fail @@ simple_error "??" in
let%bind lstl = bind_map_list aux lst in
ok @@ D_big_map lstl
| E_constant ("PAIR" , fst::snd::[]) ->
let%bind fstl = expression_to_value fst in
let%bind sndl = expression_to_value snd in
ok @@ D_pair (fstl , sndl)
| E_constant ("UNIT", _) -> ok @@ D_unit
| E_constant ("UPDATE", _) ->
let rec handle_prev upd =
match upd.content with
| E_constant ("UPDATE" , [k;v;prev]) ->
begin
match v.content with
| E_constant ("SOME" , [i]) ->
let%bind kl = expression_to_value k in
let%bind il = expression_to_value i in
let%bind prevl = handle_prev prev in
ok @@ (kl,il)::prevl
| E_constant ("NONE" , []) ->
let%bind prevl = handle_prev prev in
ok @@ prevl
| _ -> failwith "UPDATE second parameter is not an option"
end
| E_make_empty_map _ ->
ok @@ []
| _ -> failwith "Ill-constructed map"
in
begin
match exp.type_value with
| T_big_map _ ->
let%bind kvl = handle_prev exp in
ok @@ D_big_map kvl
| T_map _ ->
let%bind kvl = handle_prev exp in
ok @@ D_map kvl
| _ -> failwith "UPDATE with a non-map type_value"
end
| _ as nl ->
let expp = Format.asprintf "'%a'" PP.expression' nl in
fail @@ simple_error ("Can not convert expression "^expp^" to literal")

View File

@ -417,7 +417,7 @@ let big_map () : unit result =
let%bind () =
let make_input = fun n -> ez [(23, n) ; (42, 4)] in
let make_expected = e_int in
expect_eq_n ?input_to_value:(Some true) program "gf" make_input make_expected
expect_eq_n ~input_to_value:true program "gf" make_input make_expected
in
let%bind () =
let make_input = fun n ->