Fix/simplify big_maps using Babylon
This commit is contained in:
parent
ae7c92844c
commit
81c49f4342
@ -37,14 +37,6 @@ let syntax =
|
|||||||
info ~docv ~doc ["syntax" ; "s"] in
|
info ~docv ~doc ["syntax" ; "s"] in
|
||||||
value @@ opt string "auto" info
|
value @@ opt string "auto" info
|
||||||
|
|
||||||
let bigmap =
|
|
||||||
let open Arg in
|
|
||||||
let info =
|
|
||||||
let docv = "BIGMAP" in
|
|
||||||
let doc = "$(docv) is necessary when your storage embeds a big_map." in
|
|
||||||
info ~docv ~doc ["bigmap"] in
|
|
||||||
value @@ flag info
|
|
||||||
|
|
||||||
let amount =
|
let amount =
|
||||||
let open Arg in
|
let open Arg in
|
||||||
let info =
|
let info =
|
||||||
@ -121,31 +113,30 @@ let compile_parameter =
|
|||||||
(term , Term.info ~docs cmdname)
|
(term , Term.info ~docs cmdname)
|
||||||
|
|
||||||
let compile_storage =
|
let compile_storage =
|
||||||
let f source_file entry_point expression syntax display_format michelson_format bigmap =
|
let f source_file entry_point expression syntax display_format michelson_format =
|
||||||
toplevel ~display_format @@
|
toplevel ~display_format @@
|
||||||
let%bind value =
|
let%bind value =
|
||||||
trace (simple_error "compile-storage") @@
|
trace (simple_error "compile-storage") @@
|
||||||
Ligo.Run.Of_source.compile_file_contract_storage ~value:bigmap source_file entry_point expression (Syntax_name syntax) in
|
Ligo.Run.Of_source.compile_file_contract_storage source_file entry_point expression (Syntax_name syntax) in
|
||||||
ok @@ Format.asprintf "%a\n" (Main.Display.michelson_pp michelson_format) value
|
ok @@ Format.asprintf "%a\n" (Main.Display.michelson_pp michelson_format) value
|
||||||
in
|
in
|
||||||
let term =
|
let term =
|
||||||
Term.(const f $ source_file 0 $ entry_point 1 $ expression "STORAGE" 2 $ syntax $ display_format $ michelson_code_format $ bigmap) in
|
Term.(const f $ source_file 0 $ entry_point 1 $ expression "STORAGE" 2 $ syntax $ display_format $ michelson_code_format) in
|
||||||
let cmdname = "compile-storage" in
|
let cmdname = "compile-storage" in
|
||||||
let docs = "Subcommand: compile an initial storage in ligo syntax to a michelson expression. The resulting michelson expression can be passed as an argument in a transaction which originates a contract. See `ligo " ^ cmdname ^ " --help' for a list of options specific to this subcommand." in
|
let docs = "Subcommand: compile an initial storage in ligo syntax to a michelson expression. The resulting michelson expression can be passed as an argument in a transaction which originates a contract. See `ligo " ^ cmdname ^ " --help' for a list of options specific to this subcommand." in
|
||||||
(term , Term.info ~docs cmdname)
|
(term , Term.info ~docs cmdname)
|
||||||
|
|
||||||
let dry_run =
|
let dry_run =
|
||||||
let f source_file entry_point storage input amount sender source syntax display_format bigmap =
|
let f source_file entry_point storage input amount sender source syntax display_format =
|
||||||
toplevel ~display_format @@
|
toplevel ~display_format @@
|
||||||
let%bind output =
|
let%bind output =
|
||||||
Ligo.Run.Of_source.run_contract
|
Ligo.Run.Of_source.run_contract
|
||||||
~options:{ amount ; sender ; source }
|
~options:{ amount ; sender ; source }
|
||||||
~storage_value:bigmap
|
|
||||||
source_file entry_point storage input (Syntax_name syntax) in
|
source_file entry_point storage input (Syntax_name syntax) in
|
||||||
ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression output
|
ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression output
|
||||||
in
|
in
|
||||||
let term =
|
let term =
|
||||||
Term.(const f $ source_file 0 $ entry_point 1 $ expression "PARAMETER" 2 $ expression "STORAGE" 3 $ amount $ sender $ source $ syntax $ display_format $ bigmap) in
|
Term.(const f $ source_file 0 $ entry_point 1 $ expression "PARAMETER" 2 $ expression "STORAGE" 3 $ amount $ sender $ source $ syntax $ display_format) in
|
||||||
let cmdname = "dry-run" in
|
let cmdname = "dry-run" in
|
||||||
let docs = "Subcommand: run a smart-contract with the given storage and input." in
|
let docs = "Subcommand: run a smart-contract with the given storage and input." in
|
||||||
(term , Term.info ~docs cmdname)
|
(term , Term.info ~docs cmdname)
|
||||||
|
@ -2,17 +2,6 @@ open Trace
|
|||||||
open Mini_c
|
open Mini_c
|
||||||
open Tezos_utils
|
open Tezos_utils
|
||||||
|
|
||||||
let compile_value : value -> type_value -> Michelson.t result = fun x a ->
|
|
||||||
let%bind body = Compiler.Program.translate_value x a in
|
|
||||||
let body = Self_michelson.optimize body in
|
|
||||||
ok body
|
|
||||||
|
|
||||||
let compile_expression_as_value : expression -> _ result = fun e ->
|
|
||||||
let%bind value = expression_to_value e in
|
|
||||||
let%bind result = compile_value value e.type_value in
|
|
||||||
let result = Self_michelson.optimize result in
|
|
||||||
ok result
|
|
||||||
|
|
||||||
let compile_expression_as_function : expression -> _ result = fun e ->
|
let compile_expression_as_function : expression -> _ result = fun e ->
|
||||||
let (input , output) = t_unit , e.type_value in
|
let (input , output) = t_unit , e.type_value in
|
||||||
let%bind body = Compiler.Program.translate_expression e Compiler.Environment.empty in
|
let%bind body = Compiler.Program.translate_expression e Compiler.Environment.empty in
|
||||||
|
@ -1,6 +1,5 @@
|
|||||||
open Ast_simplified
|
open Ast_simplified
|
||||||
open Trace
|
open Trace
|
||||||
open Tezos_utils
|
|
||||||
|
|
||||||
let compile_contract_entry (program : program) entry_point =
|
let compile_contract_entry (program : program) entry_point =
|
||||||
let%bind (prog_typed , state) = Typer.type_program program in
|
let%bind (prog_typed , state) = Typer.type_program program in
|
||||||
@ -18,17 +17,6 @@ let compile_expression_as_function_entry (program : program) entry_point : _ res
|
|||||||
Of_typed.compile_expression_as_function_entry typed_program entry_point
|
Of_typed.compile_expression_as_function_entry typed_program entry_point
|
||||||
|
|
||||||
(* TODO: do we need to thread the state here? Also, make the state arg. optional. *)
|
(* TODO: do we need to thread the state here? Also, make the state arg. optional. *)
|
||||||
let compile_expression_as_value ?(env = Ast_typed.Environment.full_empty) ~(state : Typer.Solver.state) ae : Michelson.t result =
|
|
||||||
let%bind (typed , state) = Typer.type_expression env state ae in
|
|
||||||
(* TODO: move this to typer.ml *)
|
|
||||||
let typed =
|
|
||||||
if Typer.use_new_typer then
|
|
||||||
let () = failwith "TODO : subst all" in let _todo = ignore (env, state) in typed
|
|
||||||
else
|
|
||||||
typed
|
|
||||||
in
|
|
||||||
Of_typed.compile_expression_as_value typed
|
|
||||||
|
|
||||||
let compile_expression_as_function ?(env = Ast_typed.Environment.full_empty) ~(state : Typer.Solver.state) (ae : Ast_simplified.expression) : _ result =
|
let compile_expression_as_function ?(env = Ast_typed.Environment.full_empty) ~(state : Typer.Solver.state) (ae : Ast_simplified.expression) : _ result =
|
||||||
let%bind (typed , state) = Typer.type_expression env state ae in
|
let%bind (typed , state) = Typer.type_expression env state ae in
|
||||||
(* TODO: move this to typer.ml *)
|
(* TODO: move this to typer.ml *)
|
||||||
|
@ -1,13 +1,7 @@
|
|||||||
open Trace
|
open Trace
|
||||||
open Ast_typed
|
open Ast_typed
|
||||||
open Tezos_utils
|
|
||||||
|
|
||||||
|
|
||||||
let compile_expression_as_value : annotated_expression -> Michelson.t result = fun e ->
|
|
||||||
let%bind mini_c_expression = Transpiler.transpile_annotated_expression e in
|
|
||||||
let%bind expr = Of_mini_c.compile_expression_as_value mini_c_expression in
|
|
||||||
ok expr
|
|
||||||
|
|
||||||
let compile_expression_as_function : annotated_expression -> _ result = fun e ->
|
let compile_expression_as_function : annotated_expression -> _ result = fun e ->
|
||||||
let%bind mini_c_expression = Transpiler.transpile_annotated_expression e in
|
let%bind mini_c_expression = Transpiler.transpile_annotated_expression e in
|
||||||
let%bind expr = Of_mini_c.compile_expression_as_function mini_c_expression in
|
let%bind expr = Of_mini_c.compile_expression_as_function mini_c_expression in
|
||||||
@ -18,12 +12,6 @@ let compile_function : annotated_expression -> _ result = fun e ->
|
|||||||
let%bind expr = Of_mini_c.compile_function mini_c_expression in
|
let%bind expr = Of_mini_c.compile_function mini_c_expression in
|
||||||
ok expr
|
ok expr
|
||||||
|
|
||||||
(*
|
|
||||||
val compile_value : annotated_expression -> Michelson.t result
|
|
||||||
This requires writing a function
|
|
||||||
`transpile_expression_as_value : annotated_expression -> Mini_c.value result`
|
|
||||||
*)
|
|
||||||
|
|
||||||
let compile_function_entry : program -> string -> _ = fun p entry ->
|
let compile_function_entry : program -> string -> _ = fun p entry ->
|
||||||
let%bind prog_mini_c = Transpiler.transpile_program p in
|
let%bind prog_mini_c = Transpiler.transpile_program p in
|
||||||
Of_mini_c.compile_function_entry prog_mini_c entry
|
Of_mini_c.compile_function_entry prog_mini_c entry
|
||||||
|
@ -29,18 +29,6 @@ let evaluate_entry ?options program entry =
|
|||||||
let%bind ex_ty_value = Of_michelson.evaluate ?options code in
|
let%bind ex_ty_value = Of_michelson.evaluate ?options code in
|
||||||
Compile.Of_mini_c.uncompile_value ex_ty_value
|
Compile.Of_mini_c.uncompile_value ex_ty_value
|
||||||
|
|
||||||
let run_function ?options expression input ty =
|
|
||||||
let%bind code = Compile.Of_mini_c.compile_function expression in
|
|
||||||
let%bind input = Compile.Of_mini_c.compile_value input ty in
|
|
||||||
let%bind ex_ty_value = Of_michelson.run ?options code input in
|
|
||||||
Compile.Of_mini_c.uncompile_value ex_ty_value
|
|
||||||
|
|
||||||
let run_function_value ?options expression input ty =
|
|
||||||
let%bind code = Compile.Of_mini_c.compile_function expression in
|
|
||||||
let%bind input = Compile.Of_mini_c.compile_value input ty in
|
|
||||||
let%bind ex_ty_value = Of_michelson.run ?options code input in
|
|
||||||
Compile.Of_mini_c.uncompile_value ex_ty_value
|
|
||||||
|
|
||||||
let run_function_entry ?options program entry input =
|
let run_function_entry ?options program entry input =
|
||||||
let%bind code = Compile.Of_mini_c.compile_function_entry program entry in
|
let%bind code = Compile.Of_mini_c.compile_function_entry program entry in
|
||||||
let%bind input_michelson =
|
let%bind input_michelson =
|
||||||
|
@ -1,36 +1,30 @@
|
|||||||
open Trace
|
open Trace
|
||||||
open Ast_simplified
|
open Ast_simplified
|
||||||
|
|
||||||
let compile_expression ?(value = false) ?env ~state expr = (* TODO: state optional *)
|
let compile_expression ?env ~state expr = (* TODO: state optional *)
|
||||||
if value
|
|
||||||
then (
|
|
||||||
Compile.Of_simplified.compile_expression_as_value ?env ~state expr
|
|
||||||
)
|
|
||||||
else (
|
|
||||||
let%bind code = Compile.Of_simplified.compile_expression_as_function ?env ~state expr in
|
let%bind code = Compile.Of_simplified.compile_expression_as_function ?env ~state expr in
|
||||||
Of_michelson.evaluate_michelson code
|
Of_michelson.evaluate_michelson code
|
||||||
)
|
|
||||||
|
|
||||||
let run_typed_program (* TODO: this runs an *untyped* program, not a typed one. *)
|
let run_typed_program (* TODO: this runs an *untyped* program, not a typed one. *)
|
||||||
?options ?input_to_value
|
?options
|
||||||
(program : Ast_typed.program) (state : Typer.Solver.state) (entry : string)
|
(program : Ast_typed.program) (state : Typer.Solver.state) (entry : string)
|
||||||
(input : expression) : expression result =
|
(input : expression) : expression result =
|
||||||
let%bind code = Compile.Of_typed.compile_function_entry program entry in
|
let%bind code = Compile.Of_typed.compile_function_entry program entry in
|
||||||
let%bind input =
|
let%bind input =
|
||||||
let env = Ast_typed.program_environment program in
|
let env = Ast_typed.program_environment program in
|
||||||
compile_expression ?value:input_to_value ~env ~state input
|
compile_expression ~env ~state input
|
||||||
in
|
in
|
||||||
let%bind ex_ty_value = Of_michelson.run ?options code input in
|
let%bind ex_ty_value = Of_michelson.run ?options code input in
|
||||||
Compile.Of_simplified.uncompile_typed_program_entry_function_result program entry ex_ty_value
|
Compile.Of_simplified.uncompile_typed_program_entry_function_result program entry ex_ty_value
|
||||||
|
|
||||||
let run_failwith_program
|
let run_failwith_program
|
||||||
?options ?input_to_value
|
?options
|
||||||
(program : Ast_typed.program) (state : Typer.Solver.state) (entry : string)
|
(program : Ast_typed.program) (state : Typer.Solver.state) (entry : string)
|
||||||
(input : expression) : Of_michelson.failwith_res result =
|
(input : expression) : Of_michelson.failwith_res result =
|
||||||
let%bind code = Compile.Of_typed.compile_function_entry program entry in
|
let%bind code = Compile.Of_typed.compile_function_entry program entry in
|
||||||
let%bind input =
|
let%bind input =
|
||||||
let env = Ast_typed.program_environment program in
|
let env = Ast_typed.program_environment program in
|
||||||
compile_expression ?value:input_to_value ~env ~state input
|
compile_expression ~env ~state input
|
||||||
in
|
in
|
||||||
Of_michelson.get_exec_error ?options code input
|
Of_michelson.get_exec_error ?options code input
|
||||||
|
|
||||||
|
@ -70,23 +70,23 @@ let compile_expression : string -> Typer.Solver.state -> Compile.Helpers.s_synta
|
|||||||
let%bind simplified = Compile.Helpers.parsify_expression syntax expression in
|
let%bind simplified = Compile.Helpers.parsify_expression syntax expression in
|
||||||
Of_simplified.compile_expression ~state simplified
|
Of_simplified.compile_expression ~state simplified
|
||||||
|
|
||||||
let compile_file_contract_storage ~value : string -> string -> string -> Compile.Helpers.s_syntax -> Michelson.t result =
|
let compile_file_contract_storage : string -> string -> string -> Compile.Helpers.s_syntax -> Michelson.t result =
|
||||||
fun source_filename _entry_point expression syntax ->
|
fun source_filename _entry_point expression syntax ->
|
||||||
let%bind (program , state) = Compile.Of_source.type_file syntax source_filename in
|
let%bind (program , state) = Compile.Of_source.type_file syntax source_filename in
|
||||||
let env = Ast_typed.program_environment program in
|
let env = Ast_typed.program_environment program in
|
||||||
let%bind syntax = Compile.Helpers.syntax_to_variant syntax (Some source_filename) in
|
let%bind syntax = Compile.Helpers.syntax_to_variant syntax (Some source_filename) in
|
||||||
let%bind simplified = Compile.Helpers.parsify_expression syntax expression in
|
let%bind simplified = Compile.Helpers.parsify_expression syntax expression in
|
||||||
Of_simplified.compile_expression ~value simplified ~env ~state
|
Of_simplified.compile_expression simplified ~env ~state
|
||||||
|
|
||||||
let compile_file_contract_args =
|
let compile_file_contract_args =
|
||||||
fun ?value source_filename _entry_point storage parameter syntax ->
|
fun source_filename _entry_point storage parameter syntax ->
|
||||||
let%bind (program , state) = Compile.Of_source.type_file syntax source_filename in
|
let%bind (program , state) = Compile.Of_source.type_file syntax source_filename in
|
||||||
let env = Ast_typed.program_environment program in
|
let env = Ast_typed.program_environment program in
|
||||||
let%bind syntax = Compile.Helpers.syntax_to_variant syntax (Some source_filename) in
|
let%bind syntax = Compile.Helpers.syntax_to_variant syntax (Some source_filename) in
|
||||||
let%bind storage_simplified = Compile.Helpers.parsify_expression syntax storage in
|
let%bind storage_simplified = Compile.Helpers.parsify_expression syntax storage in
|
||||||
let%bind parameter_simplified = Compile.Helpers.parsify_expression syntax parameter in
|
let%bind parameter_simplified = Compile.Helpers.parsify_expression syntax parameter in
|
||||||
let args = Ast_simplified.e_pair storage_simplified parameter_simplified in
|
let args = Ast_simplified.e_pair storage_simplified parameter_simplified in
|
||||||
Of_simplified.compile_expression ?value args ~env ~state
|
Of_simplified.compile_expression args ~env ~state
|
||||||
|
|
||||||
type dry_run_options =
|
type dry_run_options =
|
||||||
{ amount : string ;
|
{ amount : string ;
|
||||||
@ -120,11 +120,11 @@ let make_dry_run_options (opts : dry_run_options) : Of_michelson.options result
|
|||||||
ok (Some source) in
|
ok (Some source) in
|
||||||
ok @@ make_options ~amount ?source:sender ?payer:source ()
|
ok @@ make_options ~amount ?source:sender ?payer:source ()
|
||||||
|
|
||||||
let run_contract ~options ?storage_value source_filename entry_point storage parameter syntax =
|
let run_contract ~options source_filename entry_point storage parameter syntax =
|
||||||
let%bind (program , state) = Compile.Of_source.type_file syntax source_filename in
|
let%bind (program , state) = Compile.Of_source.type_file syntax source_filename in
|
||||||
let () = Typer.Solver.discard_state state in
|
let () = Typer.Solver.discard_state state in
|
||||||
let%bind code = Compile.Of_typed.compile_function_entry program entry_point in
|
let%bind code = Compile.Of_typed.compile_function_entry program entry_point in
|
||||||
let%bind args = compile_file_contract_args ?value:storage_value source_filename entry_point storage parameter syntax in
|
let%bind args = compile_file_contract_args source_filename entry_point storage parameter syntax in
|
||||||
let%bind options = make_dry_run_options options in
|
let%bind options = make_dry_run_options options in
|
||||||
let%bind ex_value_ty = Of_michelson.run ~options code args in
|
let%bind ex_value_ty = Of_michelson.run ~options code args in
|
||||||
Compile.Of_simplified.uncompile_typed_program_entry_function_result program entry_point ex_value_ty
|
Compile.Of_simplified.uncompile_typed_program_entry_function_result program entry_point ex_value_ty
|
||||||
|
@ -1,15 +1,9 @@
|
|||||||
open Trace
|
open Trace
|
||||||
open Ast_typed
|
open Ast_typed
|
||||||
|
|
||||||
let compile_expression ?(value = false) expr =
|
let compile_expression expr =
|
||||||
if value
|
|
||||||
then (
|
|
||||||
Compile.Of_typed.compile_expression_as_value expr
|
|
||||||
)
|
|
||||||
else (
|
|
||||||
let%bind code = Compile.Of_typed.compile_expression_as_function expr in
|
let%bind code = Compile.Of_typed.compile_expression_as_function expr in
|
||||||
Of_michelson.evaluate_michelson code
|
Of_michelson.evaluate_michelson code
|
||||||
)
|
|
||||||
|
|
||||||
let run_function ?options f input =
|
let run_function ?options f input =
|
||||||
let%bind code = Compile.Of_typed.compile_function f in
|
let%bind code = Compile.Of_typed.compile_function f in
|
||||||
|
@ -466,7 +466,7 @@ and transpile_annotated_expression (ae:AST.annotated_expression) : expression re
|
|||||||
bind_map_pair (transpile_annotated_expression) (k , v') in
|
bind_map_pair (transpile_annotated_expression) (k , v') in
|
||||||
return @@ E_constant ("UPDATE", [k' ; v' ; prev'])
|
return @@ E_constant ("UPDATE", [k' ; v' ; prev'])
|
||||||
in
|
in
|
||||||
let init = return @@ E_make_empty_map (src, dst) in
|
let init = return @@ E_make_empty_big_map (src, dst) in
|
||||||
List.fold_left aux init m
|
List.fold_left aux init m
|
||||||
)
|
)
|
||||||
| E_look_up dsi -> (
|
| E_look_up dsi -> (
|
||||||
|
@ -25,7 +25,9 @@ let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f ini
|
|||||||
let%bind init' = f init e in
|
let%bind init' = f init e in
|
||||||
match e.content with
|
match e.content with
|
||||||
| E_variable _ | E_skip | E_make_none _
|
| E_variable _ | E_skip | E_make_none _
|
||||||
| E_make_empty_map (_,_) | E_make_empty_list _
|
| E_make_empty_map _
|
||||||
|
| E_make_empty_big_map _
|
||||||
|
| E_make_empty_list _
|
||||||
| E_make_empty_set _ -> (
|
| E_make_empty_set _ -> (
|
||||||
ok init'
|
ok init'
|
||||||
)
|
)
|
||||||
@ -91,7 +93,10 @@ let rec map_expression : mapper -> expression -> expression result = fun f e ->
|
|||||||
let return content = ok { e' with content } in
|
let return content = ok { e' with content } in
|
||||||
match e'.content with
|
match e'.content with
|
||||||
| E_variable _ | E_literal _ | E_skip | E_make_none _
|
| E_variable _ | E_literal _ | E_skip | E_make_none _
|
||||||
| E_make_empty_map (_,_) | E_make_empty_list _ | E_make_empty_set _ as em -> return em
|
| E_make_empty_map _
|
||||||
|
| E_make_empty_big_map _
|
||||||
|
| E_make_empty_list _
|
||||||
|
| E_make_empty_set _ as em -> return em
|
||||||
| E_constant (name, lst) -> (
|
| E_constant (name, lst) -> (
|
||||||
let%bind lst' = bind_map_list self lst in
|
let%bind lst' = bind_map_list self lst in
|
||||||
return @@ E_constant (name,lst')
|
return @@ E_constant (name,lst')
|
||||||
|
@ -22,6 +22,7 @@ let rec is_pure : expression -> bool = fun e ->
|
|||||||
| E_skip
|
| E_skip
|
||||||
| E_variable _
|
| E_variable _
|
||||||
| E_make_empty_map _
|
| E_make_empty_map _
|
||||||
|
| E_make_empty_big_map _
|
||||||
| E_make_empty_list _
|
| E_make_empty_list _
|
||||||
| E_make_empty_set _
|
| E_make_empty_set _
|
||||||
| E_make_none _
|
| E_make_none _
|
||||||
|
@ -238,6 +238,9 @@ and translate_expression (expr:expression) (env:environment) : michelson result
|
|||||||
| E_make_empty_map sd ->
|
| E_make_empty_map sd ->
|
||||||
let%bind (src, dst) = bind_map_pair Compiler_type.type_ sd in
|
let%bind (src, dst) = bind_map_pair Compiler_type.type_ sd in
|
||||||
return @@ i_empty_map src dst
|
return @@ i_empty_map src dst
|
||||||
|
| E_make_empty_big_map sd ->
|
||||||
|
let%bind (src, dst) = bind_map_pair Compiler_type.type_ sd in
|
||||||
|
return @@ i_empty_big_map src dst
|
||||||
| E_make_empty_list t ->
|
| E_make_empty_list t ->
|
||||||
let%bind t' = Compiler_type.type_ t in
|
let%bind t' = Compiler_type.type_ t in
|
||||||
return @@ i_nil t'
|
return @@ i_nil t'
|
||||||
|
@ -6,19 +6,19 @@ open Protocol
|
|||||||
open Script_typed_ir
|
open Script_typed_ir
|
||||||
open Script_ir_translator
|
open Script_ir_translator
|
||||||
|
|
||||||
let rec translate_value ?bm_opt (Ex_typed_value (ty, value)) : value result =
|
let rec translate_value (Ex_typed_value (ty, value)) : value result =
|
||||||
match (ty, value) with
|
match (ty, value) with
|
||||||
| Pair_t ((a_ty, _, _), (b_ty, _, _), _ , _), (a, b) -> (
|
| Pair_t ((a_ty, _, _), (b_ty, _, _), _ , _), (a, b) -> (
|
||||||
let%bind a = translate_value ?bm_opt @@ Ex_typed_value(a_ty, a) in
|
let%bind a = translate_value @@ Ex_typed_value(a_ty, a) in
|
||||||
let%bind b = translate_value ?bm_opt @@ Ex_typed_value(b_ty, b) in
|
let%bind b = translate_value @@ Ex_typed_value(b_ty, b) in
|
||||||
ok @@ D_pair(a, b)
|
ok @@ D_pair(a, b)
|
||||||
)
|
)
|
||||||
| Union_t ((a_ty, _), _, _ , _), L a -> (
|
| Union_t ((a_ty, _), _, _ , _), L a -> (
|
||||||
let%bind a = translate_value ?bm_opt @@ Ex_typed_value(a_ty, a) in
|
let%bind a = translate_value @@ Ex_typed_value(a_ty, a) in
|
||||||
ok @@ D_left a
|
ok @@ D_left a
|
||||||
)
|
)
|
||||||
| Union_t (_, (b_ty, _), _ , _), R b -> (
|
| Union_t (_, (b_ty, _), _ , _), R b -> (
|
||||||
let%bind b = translate_value ?bm_opt @@ Ex_typed_value(b_ty, b) in
|
let%bind b = translate_value @@ Ex_typed_value(b_ty, b) in
|
||||||
ok @@ D_right b
|
ok @@ D_right b
|
||||||
)
|
)
|
||||||
| (Int_t _), n ->
|
| (Int_t _), n ->
|
||||||
@ -77,12 +77,6 @@ let rec translate_value ?bm_opt (Ex_typed_value (ty, value)) : value result =
|
|||||||
let aux k v acc = (k, v) :: acc in
|
let aux k v acc = (k, v) :: acc in
|
||||||
let lst = Script_ir_translator.map_fold aux m.diff [] in
|
let lst = Script_ir_translator.map_fold aux m.diff [] in
|
||||||
List.rev lst in
|
List.rev lst in
|
||||||
let%bind original_big_map =
|
|
||||||
match bm_opt with
|
|
||||||
| Some (D_big_map l) -> ok @@ l
|
|
||||||
| _ -> ok []
|
|
||||||
(* | _ -> fail @@ simple_error "Do not have access to the original big_map" . When does this matter? *)
|
|
||||||
in
|
|
||||||
let%bind lst' =
|
let%bind lst' =
|
||||||
let aux orig (k, v) =
|
let aux orig (k, v) =
|
||||||
let%bind k' = translate_value (Ex_typed_value (k_ty, k)) in
|
let%bind k' = translate_value (Ex_typed_value (k_ty, k)) in
|
||||||
@ -93,7 +87,7 @@ let rec translate_value ?bm_opt (Ex_typed_value (ty, value)) : value result =
|
|||||||
if (List.mem_assoc k' orig) then ok @@ (k', v')::orig_rem
|
if (List.mem_assoc k' orig) then ok @@ (k', v')::orig_rem
|
||||||
else ok @@ (k', v')::orig
|
else ok @@ (k', v')::orig
|
||||||
| None -> ok orig_rem in
|
| None -> ok orig_rem in
|
||||||
bind_fold_list aux original_big_map lst in
|
bind_fold_list aux [] lst in
|
||||||
ok @@ D_big_map lst'
|
ok @@ D_big_map lst'
|
||||||
| (List_t (ty, _ , _)), lst ->
|
| (List_t (ty, _ , _)), lst ->
|
||||||
let%bind lst' =
|
let%bind lst' =
|
||||||
|
@ -3,4 +3,4 @@ open Proto_alpha_utils.Memory_proto_alpha
|
|||||||
open X
|
open X
|
||||||
open Proto_alpha_utils.Trace
|
open Proto_alpha_utils.Trace
|
||||||
|
|
||||||
val translate_value : ?bm_opt:value -> ex_typed_value -> value result
|
val translate_value : ex_typed_value -> value result
|
||||||
|
@ -77,6 +77,7 @@ and expression' ppf (e:expression') = match e with
|
|||||||
| E_constant(p, lst) -> fprintf ppf "%s %a" p (pp_print_list ~pp_sep:space_sep expression) lst
|
| E_constant(p, lst) -> fprintf ppf "%s %a" p (pp_print_list ~pp_sep:space_sep expression) lst
|
||||||
| E_literal v -> fprintf ppf "L(%a)" value v
|
| E_literal v -> fprintf ppf "L(%a)" value v
|
||||||
| E_make_empty_map _ -> fprintf ppf "map[]"
|
| E_make_empty_map _ -> fprintf ppf "map[]"
|
||||||
|
| E_make_empty_big_map _ -> fprintf ppf "big_map[]"
|
||||||
| E_make_empty_list _ -> fprintf ppf "list[]"
|
| E_make_empty_list _ -> fprintf ppf "list[]"
|
||||||
| E_make_empty_set _ -> fprintf ppf "set[]"
|
| E_make_empty_set _ -> fprintf ppf "set[]"
|
||||||
| E_make_none _ -> fprintf ppf "none"
|
| E_make_none _ -> fprintf ppf "none"
|
||||||
|
@ -2,10 +2,7 @@ module Types = Types
|
|||||||
include Types
|
include Types
|
||||||
|
|
||||||
module PP = PP
|
module PP = PP
|
||||||
module Combinators = struct
|
module Combinators = Combinators
|
||||||
include Combinators
|
|
||||||
include Combinators_smart
|
|
||||||
end
|
|
||||||
include Combinators
|
include Combinators
|
||||||
module Environment = Environment
|
module Environment = Environment
|
||||||
include Misc
|
include Misc
|
||||||
|
@ -42,6 +42,7 @@ module Free_variables = struct
|
|||||||
| E_application (f, x) -> unions @@ [ self f ; self x ]
|
| E_application (f, x) -> unions @@ [ self f ; self x ]
|
||||||
| E_variable n -> var_name b n
|
| E_variable n -> var_name b n
|
||||||
| E_make_empty_map _ -> empty
|
| E_make_empty_map _ -> empty
|
||||||
|
| E_make_empty_big_map _ -> empty
|
||||||
| E_make_empty_list _ -> empty
|
| E_make_empty_list _ -> empty
|
||||||
| E_make_empty_set _ -> empty
|
| E_make_empty_set _ -> empty
|
||||||
| E_make_none _ -> empty
|
| E_make_none _ -> empty
|
||||||
@ -195,61 +196,3 @@ let aggregate_entry (lst : program) (name : string) (to_functionalize : bool) :
|
|||||||
Format.printf "Not functional: %a\n" PP.expression entry_expression ;
|
Format.printf "Not functional: %a\n" PP.expression entry_expression ;
|
||||||
fail @@ Errors.not_functional_main name
|
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")
|
|
||||||
|
@ -65,6 +65,7 @@ and expression' =
|
|||||||
| E_application of (expression * expression)
|
| E_application of (expression * expression)
|
||||||
| E_variable of var_name
|
| E_variable of var_name
|
||||||
| E_make_empty_map of (type_value * type_value)
|
| E_make_empty_map of (type_value * type_value)
|
||||||
|
| E_make_empty_big_map of (type_value * type_value)
|
||||||
| E_make_empty_list of type_value
|
| E_make_empty_list of type_value
|
||||||
| E_make_empty_set of type_value
|
| E_make_empty_set of type_value
|
||||||
| E_make_none of type_value
|
| E_make_none of type_value
|
||||||
|
@ -1,34 +0,0 @@
|
|||||||
open Trace
|
|
||||||
open Mini_c
|
|
||||||
open Combinators
|
|
||||||
open Test_helpers
|
|
||||||
|
|
||||||
let run_entry_int e (n:int) : int result =
|
|
||||||
let param : value = D_int n in
|
|
||||||
let%bind result = Run.Of_mini_c.run_function_value e param t_int in
|
|
||||||
match result with
|
|
||||||
| D_int n -> ok n
|
|
||||||
| _ -> simple_fail "result is not an int"
|
|
||||||
|
|
||||||
let identity () : unit result =
|
|
||||||
let%bind f = basic_int_quote (e_var_int "input") in
|
|
||||||
let%bind result = run_entry_int f 42 in
|
|
||||||
let%bind _ = Assert.assert_equal_int ~msg:__LOC__ 42 result in
|
|
||||||
ok ()
|
|
||||||
|
|
||||||
let multiple_vars () : unit result =
|
|
||||||
let expr =
|
|
||||||
e_let_in "a" t_int (e_var_int "input") @@
|
|
||||||
e_let_in "b" t_int (e_var_int "input") @@
|
|
||||||
e_let_in "c" t_int (e_var_int "a") @@
|
|
||||||
e_let_in "output" t_int (e_var_int "c") @@
|
|
||||||
e_var_int "output" in
|
|
||||||
let%bind f = basic_int_quote expr in
|
|
||||||
let%bind result = run_entry_int f 42 in
|
|
||||||
let%bind _ = Assert.assert_equal_int ~msg:__LOC__ 42 result in
|
|
||||||
ok ()
|
|
||||||
|
|
||||||
let main = test_suite "Compiler (from Mini_C)" [
|
|
||||||
test "identity" identity ;
|
|
||||||
test "multiple_vars" multiple_vars ;
|
|
||||||
]
|
|
@ -685,7 +685,7 @@ let big_map_ type_f path : unit result =
|
|||||||
let%bind () =
|
let%bind () =
|
||||||
let make_input = fun n -> ez [(23, n) ; (42, 4)] in
|
let make_input = fun n -> ez [(23, n) ; (42, 4)] in
|
||||||
let make_expected = e_int in
|
let make_expected = e_int in
|
||||||
expect_eq_n ~input_to_value:true program "gf" make_input make_expected
|
expect_eq_n program "gf" make_input make_expected
|
||||||
in
|
in
|
||||||
let%bind () =
|
let%bind () =
|
||||||
let make_input = fun n ->
|
let make_input = fun n ->
|
||||||
@ -693,17 +693,17 @@ let big_map_ type_f path : unit result =
|
|||||||
e_tuple [(e_int n) ; m]
|
e_tuple [(e_int n) ; m]
|
||||||
in
|
in
|
||||||
let make_expected = fun n -> ez [(23 , n) ; (42 , 0)] in
|
let make_expected = fun n -> ez [(23 , n) ; (42 , 0)] in
|
||||||
expect_eq_n_pos_small ?input_to_value:(Some true) program "set_" make_input make_expected
|
expect_eq_n_pos_small program "set_" make_input make_expected
|
||||||
in
|
in
|
||||||
let%bind () =
|
let%bind () =
|
||||||
let make_input = fun n -> ez [(23, n) ; (42, 4)] in
|
let make_input = fun n -> ez [(23, n) ; (42, 4)] in
|
||||||
let make_expected = fun _ -> e_some @@ e_int 4 in
|
let make_expected = fun _ -> e_some @@ e_int 4 in
|
||||||
expect_eq_n ?input_to_value:(Some true) program "get" make_input make_expected
|
expect_eq_n program "get" make_input make_expected
|
||||||
in
|
in
|
||||||
let%bind () =
|
let%bind () =
|
||||||
let input = ez [(23, 23) ; (42, 42)] in
|
let input = ez [(23, 23) ; (42, 42)] in
|
||||||
let expected = ez [23, 23] in
|
let expected = ez [23, 23] in
|
||||||
expect_eq ?input_to_value:(Some true) program "rm" input expected
|
expect_eq program "rm" input expected
|
||||||
in
|
in
|
||||||
ok ()
|
ok ()
|
||||||
|
|
||||||
|
@ -6,7 +6,6 @@ let () =
|
|||||||
Printexc.record_backtrace true ;
|
Printexc.record_backtrace true ;
|
||||||
run_test @@ test_suite "LIGO" [
|
run_test @@ test_suite "LIGO" [
|
||||||
Integration_tests.main ;
|
Integration_tests.main ;
|
||||||
Compiler_tests.main ;
|
|
||||||
Transpiler_tests.main ;
|
Transpiler_tests.main ;
|
||||||
Typer_tests.main ;
|
Typer_tests.main ;
|
||||||
Heap_tests.main ;
|
Heap_tests.main ;
|
||||||
|
@ -31,14 +31,14 @@ let test_suite name lst = Test_suite (name , lst)
|
|||||||
|
|
||||||
open Ast_simplified.Combinators
|
open Ast_simplified.Combinators
|
||||||
|
|
||||||
let expect ?input_to_value ?options program entry_point input expecter =
|
let expect ?options program entry_point input expecter =
|
||||||
let%bind result =
|
let%bind result =
|
||||||
let run_error =
|
let run_error =
|
||||||
let title () = "expect run" in
|
let title () = "expect run" in
|
||||||
let content () = Format.asprintf "Entry_point: %s" entry_point in
|
let content () = Format.asprintf "Entry_point: %s" entry_point in
|
||||||
error title content in
|
error title content in
|
||||||
trace run_error @@
|
trace run_error @@
|
||||||
Ligo.Run.Of_simplified.run_typed_program ?input_to_value ?options program Typer.Solver.initial_state entry_point input in
|
Ligo.Run.Of_simplified.run_typed_program ?options program Typer.Solver.initial_state entry_point input in
|
||||||
expecter result
|
expecter result
|
||||||
|
|
||||||
let expect_fail ?options program entry_point input =
|
let expect_fail ?options program entry_point input =
|
||||||
@ -58,7 +58,7 @@ let expect_string_failwith ?options program entry_point input expected_failwith
|
|||||||
| Ligo.Run.Of_michelson.Failwith_string s -> Assert.assert_equal_string expected_failwith s
|
| Ligo.Run.Of_michelson.Failwith_string s -> Assert.assert_equal_string expected_failwith s
|
||||||
| _ -> simple_fail "Expected to fail with a string"
|
| _ -> simple_fail "Expected to fail with a string"
|
||||||
|
|
||||||
let expect_eq ?input_to_value ?options program entry_point input expected =
|
let expect_eq ?options program entry_point input expected =
|
||||||
let expecter = fun result ->
|
let expecter = fun result ->
|
||||||
let expect_error =
|
let expect_error =
|
||||||
let title () = "expect result" in
|
let title () = "expect result" in
|
||||||
@ -68,7 +68,7 @@ let expect_eq ?input_to_value ?options program entry_point input expected =
|
|||||||
error title content in
|
error title content in
|
||||||
trace expect_error @@
|
trace expect_error @@
|
||||||
Ast_simplified.Misc.assert_value_eq (expected , result) in
|
Ast_simplified.Misc.assert_value_eq (expected , result) in
|
||||||
expect ?input_to_value ?options program entry_point input expecter
|
expect ?options program entry_point input expecter
|
||||||
|
|
||||||
let expect_evaluate program entry_point expecter =
|
let expect_evaluate program entry_point expecter =
|
||||||
let error =
|
let error =
|
||||||
@ -95,23 +95,23 @@ let expect_n_aux ?options lst program entry_point make_input make_expecter =
|
|||||||
let%bind _ = bind_map_list aux lst in
|
let%bind _ = bind_map_list aux lst in
|
||||||
ok ()
|
ok ()
|
||||||
|
|
||||||
let expect_eq_n_aux ?input_to_value ?options lst program entry_point make_input make_expected =
|
let expect_eq_n_aux ?options lst program entry_point make_input make_expected =
|
||||||
let aux n =
|
let aux n =
|
||||||
let input = make_input n in
|
let input = make_input n in
|
||||||
let expected = make_expected n in
|
let expected = make_expected n in
|
||||||
trace (simple_error ("expect_eq_n " ^ (string_of_int n))) @@
|
trace (simple_error ("expect_eq_n " ^ (string_of_int n))) @@
|
||||||
let result = expect_eq ?input_to_value ?options program entry_point input expected in
|
let result = expect_eq ?options program entry_point input expected in
|
||||||
result
|
result
|
||||||
in
|
in
|
||||||
let%bind _ = bind_map_list_seq aux lst in
|
let%bind _ = bind_map_list_seq aux lst in
|
||||||
ok ()
|
ok ()
|
||||||
|
|
||||||
let expect_eq_n ?input_to_value ?options = expect_eq_n_aux ?input_to_value ?options [0 ; 1 ; 2 ; 42 ; 163 ; -1]
|
let expect_eq_n ?options = expect_eq_n_aux ?options [0 ; 1 ; 2 ; 42 ; 163 ; -1]
|
||||||
let expect_eq_n_pos ?input_to_value ?options = expect_eq_n_aux ?input_to_value ?options [0 ; 1 ; 2 ; 42 ; 163]
|
let expect_eq_n_pos ?options = expect_eq_n_aux ?options [0 ; 1 ; 2 ; 42 ; 163]
|
||||||
let expect_eq_n_strict_pos ?input_to_value ?options = expect_eq_n_aux ?input_to_value ?options [2 ; 42 ; 163]
|
let expect_eq_n_strict_pos ?options = expect_eq_n_aux ?options [2 ; 42 ; 163]
|
||||||
let expect_eq_n_pos_small ?input_to_value ?options = expect_eq_n_aux ?input_to_value ?options [0 ; 1 ; 2 ; 10]
|
let expect_eq_n_pos_small ?options = expect_eq_n_aux ?options [0 ; 1 ; 2 ; 10]
|
||||||
let expect_eq_n_strict_pos_small ?input_to_value ?options = expect_eq_n_aux ?input_to_value ?options [1 ; 2 ; 10]
|
let expect_eq_n_strict_pos_small ?options = expect_eq_n_aux ?options [1 ; 2 ; 10]
|
||||||
let expect_eq_n_pos_mid ?input_to_value = expect_eq_n_aux ?input_to_value [0 ; 1 ; 2 ; 10 ; 33]
|
let expect_eq_n_pos_mid = expect_eq_n_aux [0 ; 1 ; 2 ; 10 ; 33]
|
||||||
|
|
||||||
let expect_n_pos_small ?options = expect_n_aux ?options [0 ; 2 ; 10]
|
let expect_n_pos_small ?options = expect_n_aux ?options [0 ; 2 ; 10]
|
||||||
let expect_n_strict_pos_small ?options = expect_n_aux ?options [2 ; 10]
|
let expect_n_strict_pos_small ?options = expect_n_aux ?options [2 ; 10]
|
||||||
|
@ -58,6 +58,7 @@ let i_map body = prim ~children:[body] I_MAP
|
|||||||
let i_some = prim I_SOME
|
let i_some = prim I_SOME
|
||||||
let i_lambda arg ret body = prim ~children:[arg;ret;body] I_LAMBDA
|
let i_lambda arg ret body = prim ~children:[arg;ret;body] I_LAMBDA
|
||||||
let i_empty_map src dst = prim ~children:[src;dst] I_EMPTY_MAP
|
let i_empty_map src dst = prim ~children:[src;dst] I_EMPTY_MAP
|
||||||
|
let i_empty_big_map src dst = prim ~children:[src;dst] I_EMPTY_BIG_MAP
|
||||||
let i_drop = prim I_DROP
|
let i_drop = prim I_DROP
|
||||||
let i_dropn n = prim I_DROP ~children:[int (Z.of_int n)]
|
let i_dropn n = prim I_DROP ~children:[int (Z.of_int n)]
|
||||||
let i_exec = prim I_EXEC
|
let i_exec = prim I_EXEC
|
||||||
|
Loading…
Reference in New Issue
Block a user