diff --git a/src/bin/cli.ml b/src/bin/cli.ml index 4e7897720..4cac0fe45 100644 --- a/src/bin/cli.ml +++ b/src/bin/cli.ml @@ -53,16 +53,25 @@ let display_format = info ~docv ~doc ["format" ; "display-format"] in value @@ opt string "human-readable" info +let michelson_code_format = + let open Arg in + let info = + let docv = "MICHELSON_FORMAT" in + let doc = "$(docv) is the format that will be used by compile-contract for the resulting Michelson. Available formats are 'micheline', and 'michelson' (default). Micheline is the format used by [XXX]." in + info ~docv ~doc ["michelson-format"] in + value @@ opt string "michelson" info + let compile_file = - let f source entry_point syntax display_format = + let f source entry_point syntax display_format michelson_format = toplevel ~display_format @@ + let%bind michelson_format = Main.Display.michelson_format_of_string michelson_format in let%bind contract = trace (simple_info "compiling contract to michelson") @@ Ligo.Compile.Of_source.compile_file_contract_entry source entry_point (Syntax_name syntax) in - ok @@ Format.asprintf "%a\n" Tezos_utils.Michelson.pp contract.body + ok @@ Format.asprintf "%a\n" (Main.Display.michelson_pp michelson_format) contract in let term = - Term.(const f $ source 0 $ entry_point 1 $ syntax $ display_format) in + Term.(const f $ source 0 $ entry_point 1 $ syntax $ display_format $ michelson_code_format) in let cmdname = "compile-contract" in let docs = "Subcommand: compile a contract. See `ligo " ^ cmdname ^ " --help' for a list of options specific to this subcommand." in (term , Term.info ~docs cmdname) diff --git a/src/main/compile/of_mini_c.ml b/src/main/compile/of_mini_c.ml index b8d685975..5a1ff886e 100644 --- a/src/main/compile/of_mini_c.ml +++ b/src/main/compile/of_mini_c.ml @@ -35,5 +35,18 @@ let compile_function_entry = fun program name -> let%bind aggregated = aggregate_entry program name false in compile_function aggregated +let compile_contract_entry = fun program name -> + let%bind aggregated = aggregate_entry program name false in + let%bind compiled = compile_function aggregated in + let%bind (param_ty , storage_ty) = + let%bind fun_ty = get_t_function aggregated.type_value in + Mini_c.get_t_pair (fst fun_ty) + in + let%bind param_michelson = Compiler.Type.type_ param_ty in + let%bind storage_michelson = Compiler.Type.type_ storage_ty in + let contract = Michelson.contract param_michelson storage_michelson compiled.body in + ok contract + + let uncompile_value : Proto_alpha_utils.Memory_proto_alpha.X.ex_typed_value -> value result = fun x -> Compiler.Uncompiler.translate_value x diff --git a/src/main/compile/of_simplified.ml b/src/main/compile/of_simplified.ml index 1e2a11ca9..fa27f3d6e 100644 --- a/src/main/compile/of_simplified.ml +++ b/src/main/compile/of_simplified.ml @@ -2,6 +2,10 @@ open Ast_simplified open Trace open Tezos_utils +let compile_contract_entry (program : program) entry_point = + let%bind prog_typed = Typer.type_program program in + Of_typed.compile_contract_entry prog_typed entry_point + let compile_function_entry (program : program) entry_point : _ result = let%bind prog_typed = Typer.type_program program in Of_typed.compile_function_entry prog_typed entry_point diff --git a/src/main/compile/of_source.ml b/src/main/compile/of_source.ml index fd0b93dc7..169dba0da 100644 --- a/src/main/compile/of_source.ml +++ b/src/main/compile/of_source.ml @@ -15,7 +15,8 @@ let compile_file_entry : string -> string -> s_syntax -> _ result = let compile_file_contract_entry : string -> string -> s_syntax -> _ result = fun source_filename entry_point syntax -> let%bind simplified = parse_file_program source_filename syntax in - Of_simplified.compile_function_entry simplified entry_point + let%bind compiled_contract = Of_simplified.compile_contract_entry simplified entry_point in + ok compiled_contract let compile_file_contract_parameter : string -> string -> string -> s_syntax -> Michelson.t result = fun source_filename _entry_point expression syntax -> diff --git a/src/main/compile/of_typed.ml b/src/main/compile/of_typed.ml index a8855e904..e6a33abd7 100644 --- a/src/main/compile/of_typed.ml +++ b/src/main/compile/of_typed.ml @@ -28,6 +28,10 @@ let compile_function_entry : program -> string -> _ = fun p entry -> let%bind prog_mini_c = Transpiler.transpile_program p in Of_mini_c.compile_function_entry prog_mini_c entry +let compile_contract_entry : program -> string -> _ = fun p entry -> + let%bind prog_mini_c = Transpiler.transpile_program p in + Of_mini_c.compile_contract_entry prog_mini_c entry + let compile_expression_as_function_entry : program -> string -> _ = fun p entry -> let%bind prog_mini_c = Transpiler.transpile_program p in Of_mini_c.compile_expression_as_function_entry prog_mini_c entry diff --git a/src/main/display.ml b/src/main/display.ml index 753da77ec..2d24e8008 100644 --- a/src/main/display.ml +++ b/src/main/display.ml @@ -97,3 +97,18 @@ let formatted_string_result_pp (display_format : display_format) = | `Human_readable -> string_result_pp_hr | `Dev -> string_result_pp_dev | `Json -> string_result_pp_json + +type michelson_format = [ + | `Michelson + | `Micheline +] + +let michelson_format_of_string = fun s : michelson_format result -> + match s with + | "michelson" -> ok `Michelson + | "micheline" -> ok `Micheline + | _ -> simple_fail "bad michelson format" + +let michelson_pp (mf : michelson_format) = match mf with + | `Michelson -> Michelson.pp + | `Micheline -> Michelson.pp_json diff --git a/src/test/test_helpers.ml b/src/test/test_helpers.ml index 8b1bab00b..96b5522cb 100644 --- a/src/test/test_helpers.ml +++ b/src/test/test_helpers.ml @@ -12,14 +12,14 @@ let wrap_test name f = match result with | Ok ((), annotations) -> ignore annotations; () | Error err -> - Format.printf "%a\n%!" Ligo.Display.error_pp (err ()) ; + Format.printf "%a\n%!" (Ligo.Display.error_pp ~dev:true) (err ()) ; raise Alcotest.Test_error let wrap_test_raw f = match f () with | Trace.Ok ((), annotations) -> ignore annotations; () | Error err -> - Format.printf "%a\n%!" Ligo.Display.error_pp (err ()) + Format.printf "%a\n%!" (Ligo.Display.error_pp ~dev:true) (err ()) let test name f = Test ( diff --git a/super-counter.pp.ligo b/super-counter.pp.ligo new file mode 100644 index 000000000..0097fbc63 --- /dev/null +++ b/super-counter.pp.ligo @@ -0,0 +1,65 @@ +# 1 "./src/test/contracts/super-counter.ligo" +# 1 "" +# 1 "" +# 31 "" +# 1 "/usr/include/stdc-predef.h" 1 3 4 + +# 17 "/usr/include/stdc-predef.h" 3 4 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +# 32 "" 2 +# 1 "./src/test/contracts/super-counter.ligo" +type action is +| Increment of int +| Decrement of int + +function main (const p : action ; const s : int) : (list(operation) * int) is + block {skip} with ((nil : list(operation)), + case p of + | Increment (n) -> s + n + | Decrement (n) -> s - n + end) diff --git a/vendors/ligo-utils/tezos-utils/x_michelson.ml b/vendors/ligo-utils/tezos-utils/x_michelson.ml index 88684549e..f55e1a493 100644 --- a/vendors/ligo-utils/tezos-utils/x_michelson.ml +++ b/vendors/ligo-utils/tezos-utils/x_michelson.ml @@ -86,6 +86,18 @@ let pp ppf (michelson:michelson) = let node = printable string_of_prim canonical in print_expr ppf node +let pp_json ppf (michelson : michelson) = + let open Micheline_printer in + let canonical = strip_locations michelson in + let node = printable string_of_prim canonical in + let json = Tezos_data_encoding.( + Json.construct + (Micheline.erased_encoding ~variant:"???" {comment = None} Data_encoding.string) + node + ) + in + Format.fprintf ppf "%a" Tezos_data_encoding.Json.pp json + let pp_stripped ppf (michelson:michelson) = let open Micheline_printer in let michelson' = strip_nops @@ strip_annots michelson in